00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Interbase Database Connectivity Classes }
00005 { }
00006 { Originally written by Sergey Merkuriev }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZDbcInterbase6Utils;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses
00061 Classes, SysUtils, ZDbcIntfs, ZDbcStatement,
00062 ZPlainInterbaseDriver, ZPlainFirebirdInterbaseConstants,ZCompatibility,
00063 ZDbcCachedResultSet, ZDbcLogging, ZMessages, ZVariant;
00064
00065 type
00066 { Interbase Statement Type }
00067 TZIbSqlStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
00068 stDDL, stGetSegment, stPutSegment, stExecProc, stStartTrans, stCommit,
00069 stRollback, stSelectForUpdate, stSetGenerator);
00070
00071 { Interbase Error Class}
00072 EZIBConvertError = class(Exception);
00073
00074 { Paparameter string name and it value}
00075 TZIbParam = record
00076 Name: string;
00077 Number: word;
00078 end;
00079 PZIbParam = ^TZIbParam;
00080
00081 { Interbase blob Information structure
00082 contain iformation about blob size in bytes,
00083 segments count, segment size in bytes and blob type
00084 Note: blob type can be text an binary }
00085 TIbBlobInfo = record
00086 NumSegments: Word;
00087 MaxSegmentSize: Word;
00088 BlobType: SmallInt;
00089 TotalSize: LongInt;
00090 end;
00091
00092 { Base interface for sqlda }
00093 IZSQLDA = interface
00094 ['{2D0D6029-B31C-4E39-89DC-D86D20437C35}']
00095 procedure InitFields(Parameters: boolean);
00096 procedure AllocateSQLDA;
00097 procedure FreeParamtersValues;
00098
00099 function GetData: PXSQLDA;
00100 function IsBlob(const Index: Word): boolean;
00101 function IsNullable(const Index: Word): boolean;
00102
00103 function GetFieldCount: Integer;
00104 function GetFieldSqlName(const Index: Word): string;
00105 function GetFieldRelationName(const Index: Word): string;
00106 function GetFieldOwnerName(const Index: Word): string;
00107 function GetFieldAliasName(const Index: Word): string;
00108 function GetFieldIndex(const Name: String): Word;
00109 function GetFieldScale(const Index: Word): integer;
00110 function GetFieldSqlType(const Index: Word): TZSQLType;
00111 function GetFieldLength(const Index: Word): SmallInt;
00112 function GetIbSqlType(const Index: Word): Smallint;
00113 function GetIbSqlSubType(const Index: Word): Smallint;
00114 function GetIbSqlLen(const Index: Word): Smallint;
00115 end;
00116
00117 { parameters interface sqlda}
00118 IZParamsSQLDA = interface(IZSQLDA)
00119 ['{D2C3D5E1-F3A6-4223-9A6E-3048B99A06C4}']
00120 procedure WriteBlob(const Index: Integer; Stream: TStream);
00121 procedure UpdateNull(const Index: Integer; Value: boolean);
00122 procedure UpdateBoolean(const Index: Integer; Value: boolean);
00123 procedure UpdateByte(const Index: Integer; Value: ShortInt);
00124 procedure UpdateShort(const Index: Integer; Value: SmallInt);
00125 procedure UpdateInt(const Index: Integer; Value: Integer);
00126 procedure UpdateLong(const Index: Integer; Value: Int64);
00127 procedure UpdateFloat(const Index: Integer; Value: Single);
00128 procedure UpdateDouble(const Index: Integer; Value: Double);
00129 procedure UpdateBigDecimal(const Index: Integer; Value: Extended);
00130 procedure UpdatePChar(const Index: Integer; Value: PChar);
00131 procedure UpdateString(const Index: Integer; Value: string);
00132 procedure UpdateBytes(const Index: Integer; Value: TByteDynArray);
00133 procedure UpdateDate(const Index: Integer; Value: TDateTime);
00134 procedure UpdateTime(const Index: Integer; Value: TDateTime);
00135 procedure UpdateTimestamp(const Index: Integer; Value: TDateTime);
00136 procedure UpdateQuad(const Index: Word; const Value: TISC_QUAD);
00137 end;
00138
00139 { Result interface for sqlda}
00140 IZResultSQLDA = interface(IZSQLDA)
00141 ['{D2C3D5E1-F3A6-4223-9A6E-3048B99A06C4}']
00142 procedure ReadBlobFromStream(const Index: Word; Stream: TStream);
00143 procedure ReadBlobFromString(const Index: Word; var str: string);
00144 procedure ReadBlobFromVariant(const Index: Word; var Value: Variant);
00145
00146 function IsNull(const Index: Integer): Boolean;
00147 function GetPChar(const Index: Integer): PChar;
00148 function GetString(const Index: Integer): string;
00149 function GetBoolean(const Index: Integer): Boolean;
00150 function GetByte(const Index: Integer): ShortInt;
00151 function GetShort(const Index: Integer): SmallInt;
00152 function GetInt(const Index: Integer): Integer;
00153 function GetLong(const Index: Integer): Int64;
00154 function GetFloat(const Index: Integer): Single;
00155 function GetDouble(const Index: Integer): Double;
00156 function GetBigDecimal(const Index: Integer): Extended;
00157 function GetBytes(const Index: Integer): TByteDynArray;
00158 function GetDate(const Index: Integer): TDateTime;
00159 function GetTime(const Index: Integer): TDateTime;
00160 function GetTimestamp(const Index: Integer): TDateTime;
00161 function GetValue(const Index: Word): Variant;
00162 function GetQuad(const Index: Integer): TISC_QUAD;
00163 end;
00164
00165 { Base class contain core functions to work with sqlda structure
00166 Can allocate memory for sqlda structure get basic information }
00167 TZSQLDA = class (TInterfacedObject, IZSQLDA)
00168 private
00169 FXSQLDA: PXSQLDA;
00170 FPlainDriver: IZInterbasePlainDriver;
00171 procedure CheckRange(const Index: Word);
00172 procedure IbReAlloc(var P; OldSize, NewSize: Integer);
00173 procedure SetFieldType(const Index: Word; Size: Integer; Code: Smallint;
00174 Scale: Smallint);
00175 public
00176 procedure InitFields(Parameters: boolean);
00177 procedure AllocateSQLDA; virtual;
00178 procedure FreeParamtersValues;
00179
00180 function IsBlob(const Index: Word): boolean;
00181 function IsNullable(const Index: Word): boolean;
00182
00183 function GetFieldCount: Integer;
00184 function GetFieldSqlName(const Index: Word): string;
00185 function GetFieldOwnerName(const Index: Word): string;
00186 function GetFieldRelationName(const Index: Word): string;
00187 function GetFieldAliasName(const Index: Word): string;
00188 function GetFieldIndex(const Name: String): Word;
00189 function GetFieldScale(const Index: Word): integer;
00190 function GetFieldSqlType(const Index: Word): TZSQLType;
00191 function GetFieldLength(const Index: Word): SmallInt;
00192 function GetData: PXSQLDA;
00193
00194 function GetIbSqlType(const Index: Word): Smallint;
00195 function GetIbSqlSubType(const Index: Word): Smallint;
00196 function GetIbSqlLen(const Index: Word): Smallint;
00197 end;
00198
00199 { Parameters class for sqlda structure.
00200 It clas can only write data to parameters/fields }
00201 TZParamsSQLDA = class (TZSQLDA, IZParamsSQLDA)
00202 protected
00203 FHandle: PISC_DB_HANDLE;
00204 FTransactionHandle: PISC_TR_HANDLE;
00205 private
00206 procedure EncodeString(Code: Smallint; const Index: Word; const Str: String);
00207 procedure UpdateDateTime(const Index: Integer; Value: TDateTime);
00208 public
00209 constructor Create(PlainDriver: IZInterbasePlainDriver;
00210 Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE);
00211 destructor Destroy; override;
00212
00213 procedure WriteBlob(const Index: Integer; Stream: TStream);
00214
00215 procedure UpdateNull(const Index: Integer; Value: boolean);
00216 procedure UpdateBoolean(const Index: Integer; Value: boolean);
00217 procedure UpdateByte(const Index: Integer; Value: ShortInt);
00218 procedure UpdateShort(const Index: Integer; Value: SmallInt);
00219 procedure UpdateInt(const Index: Integer; Value: Integer);
00220 procedure UpdateLong(const Index: Integer; Value: Int64);
00221 procedure UpdateFloat(const Index: Integer; Value: Single);
00222 procedure UpdateDouble(const Index: Integer; Value: Double);
00223 procedure UpdateBigDecimal(const Index: Integer; Value: Extended);
00224 procedure UpdatePChar(const Index: Integer; Value: PChar);
00225 procedure UpdateString(const Index: Integer; Value: string);
00226 procedure UpdateBytes(const Index: Integer; Value: TByteDynArray);
00227 procedure UpdateDate(const Index: Integer; Value: TDateTime);
00228 procedure UpdateTime(const Index: Integer; Value: TDateTime);
00229 procedure UpdateTimestamp(const Index: Integer; Value: TDateTime);
00230 procedure UpdateQuad(const Index: Word; const Value: TISC_QUAD);
00231 end;
00232
00233 { Resultset class for sqlda structure.
00234 It class read data from sqlda fields }
00235 TZResultSQLDA = class (TZSQLDA, IZResultSQLDA)
00236 protected
00237 FDefaults: array of Variant;
00238 FHandle: PISC_DB_HANDLE;
00239 FTransactionHandle: PISC_TR_HANDLE;
00240 private
00241 function DecodeString(const Code: Smallint; const Index: Word): string;
00242 procedure DecodeString2(const Code: Smallint; const Index: Word; out Str: string);
00243 public
00244 constructor Create(PlainDriver: IZInterbasePlainDriver;
00245 Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE);
00246 destructor Destroy; override;
00247
00248 procedure AllocateSQLDA; override;
00249
00250 procedure ReadBlobFromStream(const Index: Word; Stream: TStream);
00251 procedure ReadBlobFromString(const Index: Word; var str: string);
00252 procedure ReadBlobFromVariant(const Index: Word; var Value: Variant);
00253
00254 function IsNull(const Index: Integer): Boolean;
00255 function GetPChar(const Index: Integer): PChar;
00256 function GetString(const Index: Integer): string;
00257 function GetBoolean(const Index: Integer): Boolean;
00258 function GetByte(const Index: Integer): ShortInt;
00259 function GetShort(const Index: Integer): SmallInt;
00260 function GetInt(const Index: Integer): Integer;
00261 function GetLong(const Index: Integer): Int64;
00262 function GetFloat(const Index: Integer): Single;
00263 function GetDouble(const Index: Integer): Double;
00264 function GetBigDecimal(const Index: Integer): Extended;
00265 function GetBytes(const Index: Integer): TByteDynArray;
00266 function GetDate(const Index: Integer): TDateTime;
00267 function GetTime(const Index: Integer): TDateTime;
00268 function GetTimestamp(const Index: Integer): TDateTime;
00269 function GetValue(const Index: Word): Variant;
00270 function GetQuad(const Index: Integer): TISC_QUAD;
00271 end;
00272
00273 function RandomString(Len: integer): string;
00274 function GetCachedResultSet(SQL: string; Statement: IZStatement;
00275 NativeResultSet: IZResultSet): IZResultSet;
00276
00277 {Interbase6 Connection Functions}
00278 function GenerateDPB(Info: TStrings; var FDPBLength, Dialect: Word): PChar;
00279 function GenerateTPB(Params: TStrings; var Handle: TISC_DB_HANDLE): PISC_TEB;
00280 function GetInterbase6DatabaseParamNumber(const Value: string): word;
00281 function GetInterbase6TransactionParamNumber(const Value: string): word;
00282
00283 { Interbase6 errors functions }
00284 function GetNameSqlType(Value: Word): string;
00285 procedure CheckInterbase6Error(PlainDriver: IZInterbasePlainDriver;
00286 StatusVector: TARRAY_ISC_STATUS; LoggingCategory: TZLoggingCategory = lcOther;
00287 SQL: string = '');
00288
00289 { Interbase information functions}
00290 function GetVersion(PlainDriver: IZInterbasePlainDriver;
00291 Handle: PISC_DB_HANDLE): String;
00292 function GetDBImplementationNo(PlainDriver: IZInterbasePlainDriver;
00293 Handle: PISC_DB_HANDLE): LongInt;
00294 function GetDBImplementationClass(PlainDriver: IZInterbasePlainDriver;
00295 Handle: PISC_DB_HANDLE): LongInt;
00296 function GetLongDbInfo(PlainDriver: IZInterbasePlainDriver;
00297 Handle: PISC_DB_HANDLE; DatabaseInfoCommand: Integer): LongInt;
00298 function GetStringDbInfo(PlainDriver: IZInterbasePlainDriver;
00299 Handle: PISC_DB_HANDLE; DatabaseInfoCommand: Integer): String;
00300 function GetDBSQLDialect(PlainDriver: IZInterbasePlainDriver;
00301 Handle: PISC_DB_HANDLE): Integer;
00302
00303 { Interbase satatement functions}
00304 function PrepareStatement(PlainDriver: IZInterbasePlainDriver;
00305 Handle: PISC_DB_HANDLE; TrHandle: PISC_TR_HANDLE; Dialect: Word; SQL: string;
00306 var StmtHandle: TISC_STMT_HANDLE): TZIbSqlStatementType;
00307 procedure PrepareResultSqlData(PlainDriver: IZInterbasePlainDriver;
00308 Handle: PISC_DB_HANDLE; Dialect: Word; SQL: string;
00309 var StmtHandle: TISC_STMT_HANDLE; SqlData: IZResultSQLDA);
00310 procedure PrepareParameters(PlainDriver: IZInterbasePlainDriver; SQL: string;
00311 InParamValues: TZVariantDynArray; InParamTypes: TZSQLTypeArray; InParamCount: Integer;
00312 Dialect: Word; var StmtHandle: TISC_STMT_HANDLE; ParamSqlData: IZParamsSQLDA);
00313 procedure FreeStatement(PlainDriver: IZInterbasePlainDriver;
00314 StatementHandle: TISC_STMT_HANDLE);
00315 function GetStatementType(PlainDriver: IZInterbasePlainDriver;
00316 StmtHandle: TISC_STMT_HANDLE): TZIbSqlStatementType;
00317 function GetAffectedRows(PlainDriver: IZInterbasePlainDriver;
00318 StmtHandle: TISC_STMT_HANDLE; StatementType: TZIbSqlStatementType): integer;
00319
00320 function ConvertInterbase6ToSqlType(SqlType, SqlSubType: Integer): TZSqlType;
00321
00322 { interbase blob routines }
00323 procedure GetBlobInfo(PlainDriver: IZInterbasePlainDriver;
00324 BlobHandle: TISC_BLOB_HANDLE; var BlobInfo: TIbBlobInfo);
00325 procedure ReadBlobBufer(PlainDriver: IZInterbasePlainDriver;
00326 Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE;
00327 BlobId: TISC_QUAD; var Size: Integer; var Buffer: Pointer);
00328
00329
00330
00331 const
00332 { Default Interbase blob size for readig }
00333 DefaultBlobSegmentSize = 16 * 1024;
00334
00335 IBScaleDivisor: array[-15..-1] of Int64 = (1000000000000000,100000000000000,
00336 10000000000000,1000000000000,100000000000,10000000000,1000000000,100000000,
00337 10000000,1000000,100000,10000,1000,100,10);
00338
00339 { count database parameters }
00340 MAX_DPB_PARAMS = 67;
00341 { prefix database parameters names it used in paramters scann procedure }
00342 BPBPrefix = 'isc_dpb_';
00343 { list database parameters and their apropriate numbers }
00344 DatabaseParams: array [0..MAX_DPB_PARAMS]of TZIbParam = (
00345 (Name:'isc_dpb_version1'; Number: isc_dpb_version1),
00346 (Name:'isc_dpb_cdd_pathname'; Number: isc_dpb_cdd_pathname),
00347 (Name:'isc_dpb_allocation'; Number: isc_dpb_allocation),
00348 (Name:'isc_dpb_journal'; Number: isc_dpb_journal),
00349 (Name:'isc_dpb_page_size'; Number: isc_dpb_page_size),
00350 (Name:'isc_dpb_num_buffers'; Number: isc_dpb_num_buffers),
00351 (Name:'isc_dpb_buffer_length'; Number: isc_dpb_buffer_length),
00352 (Name:'isc_dpb_debug'; Number: isc_dpb_debug),
00353 (Name:'isc_dpb_garbage_collect'; Number: isc_dpb_garbage_collect),
00354 (Name:'isc_dpb_verify'; Number: isc_dpb_verify),
00355 (Name:'isc_dpb_sweep'; Number: isc_dpb_sweep),
00356 (Name:'isc_dpb_enable_journal'; Number: isc_dpb_enable_journal),
00357 (Name:'isc_dpb_disable_journal'; Number: isc_dpb_disable_journal),
00358 (Name:'isc_dpb_dbkey_scope'; Number: isc_dpb_dbkey_scope),
00359 (Name:'isc_dpb_number_of_users'; Number: isc_dpb_number_of_users),
00360 (Name:'isc_dpb_trace'; Number: isc_dpb_trace),
00361 (Name:'isc_dpb_no_garbage_collect'; Number: isc_dpb_no_garbage_collect),
00362 (Name:'isc_dpb_damaged'; Number: isc_dpb_damaged),
00363 (Name:'isc_dpb_license'; Number: isc_dpb_license),
00364 (Name:'isc_dpb_sys_user_name'; Number: isc_dpb_sys_user_name),
00365 (Name:'isc_dpb_encrypt_key'; Number: isc_dpb_encrypt_key),
00366 (Name:'isc_dpb_activate_shadow'; Number: isc_dpb_activate_shadow),
00367 (Name:'isc_dpb_sweep_interval'; Number: isc_dpb_sweep_interval),
00368 (Name:'isc_dpb_delete_shadow'; Number: isc_dpb_delete_shadow),
00369 (Name:'isc_dpb_force_write'; Number: isc_dpb_force_write),
00370 (Name:'isc_dpb_begin_log'; Number: isc_dpb_begin_log),
00371 (Name:'isc_dpb_quit_log'; Number: isc_dpb_quit_log),
00372 (Name:'isc_dpb_no_reserve'; Number: isc_dpb_no_reserve),
00373 (Name:'isc_dpb_username'; Number: isc_dpb_user_name),
00374 (Name:'isc_dpb_password'; Number: isc_dpb_password),
00375 (Name:'isc_dpb_password_enc'; Number: isc_dpb_password_enc),
00376 (Name:'isc_dpb_sys_user_name_enc'; Number: isc_dpb_sys_user_name_enc),
00377 (Name:'isc_dpb_interp'; Number: isc_dpb_interp),
00378 (Name:'isc_dpb_online_dump'; Number: isc_dpb_online_dump),
00379 (Name:'isc_dpb_old_file_size'; Number: isc_dpb_old_file_size),
00380 (Name:'isc_dpb_old_num_files'; Number: isc_dpb_old_num_files),
00381 (Name:'isc_dpb_old_file'; Number: isc_dpb_old_file),
00382 (Name:'isc_dpb_old_start_page'; Number: isc_dpb_old_start_page),
00383 (Name:'isc_dpb_old_start_seqno'; Number: isc_dpb_old_start_seqno),
00384 (Name:'isc_dpb_old_start_file'; Number: isc_dpb_old_start_file),
00385 (Name:'isc_dpb_drop_walfile'; Number: isc_dpb_drop_walfile),
00386 (Name:'isc_dpb_old_dump_id'; Number: isc_dpb_old_dump_id),
00387 (Name:'isc_dpb_wal_backup_dir'; Number: isc_dpb_wal_backup_dir),
00388 (Name:'isc_dpb_wal_chkptlen'; Number: isc_dpb_wal_chkptlen),
00389 (Name:'isc_dpb_wal_numbufs'; Number: isc_dpb_wal_numbufs),
00390 (Name:'isc_dpb_wal_bufsize'; Number: isc_dpb_wal_bufsize),
00391 (Name:'isc_dpb_wal_grp_cmt_wait'; Number: isc_dpb_wal_grp_cmt_wait),
00392 (Name:'isc_dpb_lc_messages'; Number: isc_dpb_lc_messages),
00393 (Name:'isc_dpb_lc_ctype'; Number: isc_dpb_lc_ctype),
00394 (Name:'isc_dpb_cache_manager'; Number: isc_dpb_cache_manager),
00395 (Name:'isc_dpb_shutdown'; Number: isc_dpb_shutdown),
00396 (Name:'isc_dpb_online'; Number: isc_dpb_online),
00397 (Name:'isc_dpb_shutdown_delay'; Number: isc_dpb_shutdown_delay),
00398 (Name:'isc_dpb_reserved'; Number: isc_dpb_reserved),
00399 (Name:'isc_dpb_overwrite'; Number: isc_dpb_overwrite),
00400 (Name:'isc_dpb_sec_attach'; Number: isc_dpb_sec_attach),
00401 (Name:'isc_dpb_disable_wal'; Number: isc_dpb_disable_wal),
00402 (Name:'isc_dpb_connect_timeout'; Number: isc_dpb_connect_timeout),
00403 (Name:'isc_dpb_dummy_packet_interval'; Number: isc_dpb_dummy_packet_interval),
00404 (Name:'isc_dpb_gbak_attach'; Number: isc_dpb_gbak_attach),
00405 (Name:'isc_dpb_sql_role_name'; Number: isc_dpb_sql_role_name),
00406 (Name:'isc_dpb_set_page_buffers'; Number: isc_dpb_set_page_buffers),
00407 (Name:'isc_dpb_working_directory'; Number: isc_dpb_working_directory),
00408 (Name:'isc_dpb_sql_dialect'; Number: isc_dpb_SQL_dialect),
00409 (Name:'isc_dpb_set_db_readonly'; Number: isc_dpb_set_db_readonly),
00410 (Name:'isc_dpb_set_db_sql_dialect'; Number: isc_dpb_set_db_SQL_dialect),
00411 (Name:'isc_dpb_gfix_attach'; Number: isc_dpb_gfix_attach),
00412 (Name:'isc_dpb_gstat_attach'; Number: isc_dpb_gstat_attach)
00413 );
00414
00415 { count transaction parameters }
00416 MAX_TPB_PARAMS = 16;
00417 { prefix transaction parameters names it used in paramters scann procedure }
00418 TPBPrefix = 'isc_tpb_';
00419 { list transaction parameters and their apropriate numbers }
00420 TransactionParams: array [0..MAX_TPB_PARAMS]of TZIbParam = (
00421 (Name:'isc_tpb_version1'; Number: isc_tpb_version1),
00422 (Name:'isc_tpb_version3'; Number: isc_tpb_version3),
00423 (Name:'isc_tpb_consistency'; Number: isc_tpb_consistency),
00424 (Name:'isc_tpb_concurrency'; Number: isc_tpb_concurrency),
00425 (Name:'isc_tpb_exclusive'; Number: isc_tpb_exclusive),
00426 (Name:'isc_tpb_shared'; Number: isc_tpb_shared),
00427 (Name:'isc_tpb_protected'; Number: isc_tpb_protected),
00428 (Name:'isc_tpb_wait'; Number: isc_tpb_wait),
00429 (Name:'isc_tpb_nowait'; Number: isc_tpb_nowait),
00430 (Name:'isc_tpb_read'; Number: isc_tpb_read),
00431 (Name:'isc_tpb_write'; Number: isc_tpb_write),
00432 (Name:'isc_tpb_ignore_limbo'; Number: isc_tpb_ignore_limbo),
00433 (Name:'isc_tpb_read_committed'; Number: isc_tpb_read_committed),
00434 (Name:'isc_tpb_rec_version'; Number: isc_tpb_rec_version),
00435 (Name:'isc_tpb_no_rec_version'; Number: isc_tpb_no_rec_version),
00436 (Name:'isc_tpb_lock_read'; Number: isc_tpb_lock_read),
00437 (Name:'isc_tpb_lock_write'; Number: isc_tpb_lock_write)
00438 );
00439
00440 implementation
00441
00442 uses
00443 {$IFNDEF VER130BELOW}
00444 Variants,
00445 {$ELSE}
00446 {$IFDEF FPC}
00447 Variants,
00448 {$ENDIF}
00449 {$ENDIF}
00450 ZSysUtils, Math, ZDbcInterbase6;
00451
00452 {**
00453 Generate specific length random string and return it
00454 @param Len a length result string
00455 @return random string
00456 }
00457 function RandomString(Len: integer): string;
00458 begin
00459 Result := '';
00460 while Length(Result) < Len do
00461 Result := Result + IntToStr(Trunc(Random(High(Integer))));
00462 if Length(Result) > Len then
00463 Result := Copy(Result, 1, Len);
00464 end;
00465
00466 {**
00467 Create CachedResultSet with using TZCachedResultSet and return it.
00468 @param SQL a sql query command
00469 @param Statement a zeos statement object
00470 @param NativeResultSet a native result set
00471 @return cached ResultSet
00472 }
00473 function GetCachedResultSet(SQL: string;
00474 Statement: IZStatement; NativeResultSet: IZResultSet): IZResultSet;
00475 var
00476 CachedResolver: TZInterbase6CachedResolver;
00477 CachedResultSet: TZCachedResultSet;
00478 begin
00479 if (Statement.GetResultSetConcurrency <> rcReadOnly)
00480 or (Statement.GetResultSetType <> rtForwardOnly) then
00481 begin
00482 CachedResolver := TZInterbase6CachedResolver.Create(
00483 Statement, NativeResultSet.GetMetadata);
00484 CachedResultSet := TZCachedResultSet.Create(NativeResultSet, SQL,
00485 CachedResolver);
00486 CachedResultSet.SetConcurrency(Statement.GetResultSetConcurrency);
00487 Result := CachedResultSet;
00488 end else
00489 Result := NativeResultSet;
00490 end;
00491
00492 {**
00493 Generate database connection string by connection information
00494 @param DPB - a database connection string
00495 @param Dialect - a sql dialect number
00496 @param Info - a list connection interbase parameters
00497 @return a generated string length
00498 }
00499 function GenerateDPB(Info: TStrings; var FDPBLength, Dialect: Word): PChar;
00500 var
00501 I, Pos, PValue: Integer;
00502 ParamNo: Word;
00503 DPB, Buffer, ParamName, ParamValue: String;
00504 begin
00505 FDPBLength := 1;
00506 DPB := Char(isc_dpb_version1);
00507
00508 for I := 0 to Info.Count-1 do
00509 begin
00510 Buffer := Info.Strings[I];
00511 Pos := FirstDelimiter(' ='#9#10#13, Buffer);
00512 ParamName := Copy(Buffer, 1, Pos-1);
00513 Delete(Buffer, 1, Pos);
00514 ParamValue := Buffer;
00515 ParamNo := GetInterbase6DatabaseParamNumber(ParamName);
00516
00517 case ParamNo of
00518 0: Continue;
00519 isc_dpb_set_db_SQL_dialect:
00520 Dialect := StrToIntDef(ParamValue, 0);
00521 isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
00522 isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
00523 isc_dpb_lc_messages, isc_dpb_lc_ctype, isc_dpb_sql_role_name:
00524 begin
00525 DPB := DPB + Char(ParamNo) + Char(Length(ParamValue)) + ParamValue;
00526 Inc(FDPBLength, 2 + Length(ParamValue));
00527 end;
00528 isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
00529 isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
00530 begin
00531 DPB := DPB + Char(ParamNo) + #1 + Char(StrToInt(ParamValue));
00532 Inc(FDPBLength, 3);
00533 end;
00534 isc_dpb_sweep:
00535 begin
00536 DPB := DPB + Char(ParamNo) + #1 + Char(isc_dpb_records);
00537 Inc(FDPBLength, 3);
00538 end;
00539 isc_dpb_sweep_interval:
00540 begin
00541 PValue := StrToInt(ParamValue);
00542 DPB := DPB + Char(ParamNo) + #4 + PChar(@PValue)[0] + PChar(@PValue)[1] +
00543 PChar(@PValue)[2] + PChar(@PValue)[3];
00544 Inc(FDPBLength, 6);
00545 end;
00546 isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
00547 isc_dpb_quit_log:
00548 begin
00549 DPB := DPB + Char(ParamNo) + #1 + #0;
00550 Inc(FDPBLength, 3);
00551 end;
00552 end;
00553 end;
00554
00555 Result := StrAlloc(FDPBLength + 1);
00556 StrPCopy(Result, DPB);
00557 end;
00558
00559 {**
00560 Generate transaction structuer by connection information
00561 @param Params - a transaction parameters list
00562 @param Dialect - a database connection handle
00563 @return a transaction ISC structure
00564 }
00565 function GenerateTPB(Params: TStrings; var Handle: TISC_DB_HANDLE): PISC_TEB;
00566 var
00567 I: Integer;
00568 TPBLength,ParamNo: Word;
00569 TempStr, ParamValue: String;
00570 TPB: PChar;
00571 IsolationLevel: Boolean;
00572 begin
00573 TPBLength := 0;
00574 TempStr := '';
00575 IsolationLevel := False;
00576
00577 { Prepare transaction parameters string }
00578 for I := 0 to Params.Count - 1 do
00579 begin
00580 ParamValue := Params.Strings[I];
00581 ParamNo := GetInterbase6TransactionParamNumber(ParamValue);
00582
00583 case ParamNo of
00584 0: Continue;
00585 isc_tpb_lock_read, isc_tpb_lock_write:
00586 begin
00587 TempStr := TempStr + Char(ParamNo) + Char(Length(ParamValue)) + ParamValue;
00588 Inc(TPBLength, Length(ParamValue) + 2);
00589 end;
00590 else
00591 begin
00592 TempStr := TempStr + Char(ParamNo);
00593 Inc(TPBLength, 1);
00594 end;
00595 end;
00596
00597 { Check what was set use transaction isolation level }
00598 if not IsolationLevel then
00599 case ParamNo of
00600 isc_tpb_concurrency, isc_tpb_consistency,
00601 isc_tpb_read_committed:
00602 IsolationLevel := True
00603 else
00604 IsolationLevel := False;
00605 end;
00606
00607 end;
00608
00609 { Allocate transaction parameters PChar buffer
00610 if temporally parameters string is empty the set null pointer for
00611 default database transaction}
00612 if (TPBLength > 0) and (IsolationLevel) then
00613 begin
00614 TPB := StrAlloc(TPBLength + 1);
00615 TPB := StrPCopy(TPB, TempStr);
00616 end else
00617 TPB := nil;
00618
00619 { Allocate transaction structure }
00620 Result := AllocMem(Sizeof(TISC_TEB));
00621 with Result^ do
00622 begin
00623 db_handle := @Handle;
00624 tpb_length := TPBLength;
00625 tpb_address := TPB;
00626 end;
00627 end;
00628
00629 {**
00630 Return interbase connection parameter number by it name
00631 @param Value - a connection parameter name
00632 @return - connection parameter number
00633 }
00634 function GetInterbase6DatabaseParamNumber(const Value: string): Word;
00635 var
00636 I: Integer;
00637 ParamName: string;
00638 begin
00639 ParamName := LowerCase(Value);
00640 Result := 0;
00641 if System.Pos(BPBPrefix, ParamName) = 1 then
00642 for I := 1 to MAX_DPB_PARAMS do
00643 begin
00644 if ParamName = DatabaseParams[I].Name then
00645 begin
00646 Result := DatabaseParams[I].Number;
00647 Break;
00648 end;
00649 end;
00650 end;
00651
00652 {**
00653 Return interbase transaction parameter number by it name
00654 @param Value - a transaction parameter name
00655 @return - transaction parameter number
00656 }
00657 function GetInterbase6TransactionParamNumber(const Value: string): Word;
00658 var
00659 I: Integer;
00660 ParamName: string;
00661 begin
00662 ParamName := LowerCase(Value);
00663 Result := 0;
00664 if System.Pos(TPBPrefix, ParamName) = 1 then
00665 for I := 1 to MAX_TPB_PARAMS do
00666 begin
00667 if ParamName = TransactionParams[I].Name then
00668 begin
00669 Result := TransactionParams[I].Number;
00670 Break;
00671 end;
00672 end;
00673 end;
00674
00675 {**
00676 Converts a Interbase6 native types into ZDBC SQL types.
00677 @param the interbase type
00678 @param the interbase subtype
00679 @return a SQL undepended type.
00680
00681 <b>Note:</b> The interbase type and subtype get from RDB$TYPES table
00682 }
00683 function ConvertInterbase6ToSqlType(SqlType, SqlSubType: Integer):
00684 TZSQLType;
00685 begin
00686 Result := ZDbcIntfs.stUnknown;
00687
00688 case SqlType of
00689 RDB_BOOLEAN: Result := stBoolean;
00690 RDB_VARCHAR2, RDB_VARCHAR, RDB_CSTRING, RDB_CSTRING2: Result := stString;
00691 RDB_CHAR, RDB_CHAR2:
00692 begin
00693 case SqlSubType of
00694 CS_NONE: Result := stString;
00695 CS_BINARY: Result := stBytes;
00696 CS_ASCII: Result := stString;
00697 CS_UNICODE_FSS: Result := stUnicodeString;
00698 else
00699
00700 Result := stString;
00701 end;
00702 end;
00703 RDB_D_FLOAT: Result := stDouble;
00704 RDB_DOUBLE: Result := stDouble;
00705 RDB_FLOAT: Result := stDouble;
00706 RDB_BLOB_ID, RDB_QUAD: Result := stLong;
00707 RDB_INT64:
00708 begin
00709 case SqlSubType of
00710 RDB_NUMBERS_NONE: Result := stLong;
00711 RDB_NUMBERS_NUMERIC: Result := stDouble;
00712 RDB_NUMBERS_DECIMAL: Result := stBigDecimal;
00713 end;
00714 end;
00715 RDB_INTEGER:
00716 begin
00717 case SqlSubType of
00718 RDB_NUMBERS_NONE: Result := stInteger;
00719 RDB_NUMBERS_NUMERIC: Result := stDouble;
00720 RDB_NUMBERS_DECIMAL: Result := stBigDecimal;
00721 end;
00722 end;
00723 RDB_SMALLINT:
00724 begin
00725 case SqlSubType of
00726 RDB_NUMBERS_NONE: Result := stShort;
00727 RDB_NUMBERS_NUMERIC: Result := stDouble;
00728 RDB_NUMBERS_DECIMAL: Result := stDouble;
00729 end;
00730 end;
00731 RDB_DATE: Result := stDate;
00732 RDB_TIME: Result := stTime;
00733 RDB_TIMESTAMP: Result := stTimestamp;
00734 RDB_BLOB:
00735 begin
00736 case SqlSubType of
00737 RDB_BLOB_NONE: Result := stBinaryStream;
00738 RDB_BLOB_TEXT: Result := stAsciiStream;
00739 RDB_BLOB_BLR: Result := stBinaryStream;
00740 RDB_BLOB_ACL: Result := stAsciiStream;
00741 RDB_BLOB_RESERVED: Result := ZDbcIntfs.stUnknown;
00742 RDB_BLOB_ENCODED: Result := stAsciiStream;
00743 RDB_BLOB_DESCRIPTION: Result := stAsciiStream;
00744 end;
00745 end;
00746 else
00747 Result := ZDbcIntfs.stUnknown;
00748 end;
00749 end;
00750
00751 {**
00752 Return Interbase SqlType by it number
00753 @param Value the SqlType number
00754 }
00755 function GetNameSqlType(Value: Word): string;
00756 begin
00757 case Value of
00758 SQL_VARYING: Result := 'SQL_VARYING';
00759 SQL_TEXT: Result := 'SQL_TEXT';
00760 SQL_DOUBLE: Result := 'SQL_DOUBLE';
00761 SQL_FLOAT: Result := 'SQL_FLOAT';
00762 SQL_LONG: Result := 'SQL_LONG';
00763 SQL_SHORT: Result := 'SQL_SHORT';
00764 SQL_TIMESTAMP: Result := 'SQL_TIMESTAMP';
00765 SQL_BLOB: Result := 'SQL_BLOB';
00766 SQL_D_FLOAT: Result := 'SQL_D_FLOAT';
00767 SQL_ARRAY: Result := 'SQL_ARRAY';
00768 SQL_QUAD: Result := 'SQL_QUAD';
00769 SQL_TYPE_TIME: Result := 'SQL_TYPE_TIME';
00770 SQL_TYPE_DATE: Result := 'SQL_TYPE_DATE';
00771 SQL_INT64: Result := 'SQL_INT64';
00772 SQL_BOOLEAN: Result := 'SQL_BOOLEAN';
00773 else
00774 Result := 'Unknown';
00775 end
00776 end;
00777
00778 {**
00779 Checks for possible sql errors.
00780 @param PlainDriver a Interbase Plain drver
00781 @param StatusVector a status vector. It contain information about error
00782 @param Sql a sql query commend
00783 }
00784 procedure CheckInterbase6Error(PlainDriver: IZInterbasePlainDriver;
00785 StatusVector: TARRAY_ISC_STATUS; LoggingCategory: TZLoggingCategory = lcOther;
00786 SQL: string = '');
00787 var
00788 Msg: array[0..1024] of Char;
00789 PStatusVector: PISC_STATUS;
00790 ErrorMessage, ErrorSqlMessage: string;
00791 ErrorCode: LongInt;
00792 begin
00793 if (StatusVector[0] = 1) and (StatusVector[1] > 0) then
00794 begin
00795 ErrorMessage:='';
00796 PStatusVector := @StatusVector;
00797 while PlainDriver.isc_interprete(Msg, @PStatusVector) > 0 do
00798 ErrorMessage := ErrorMessage + ' ' + StrPas(Msg);
00799
00800 ErrorCode := PlainDriver.isc_sqlcode(@StatusVector);
00801 PlainDriver.isc_sql_interprete(ErrorCode, Msg, 1024);
00802 ErrorSqlMessage := StrPas(Msg);
00803
00804 {$IFDEF INTERBASE_EXTENDED_MESSAGES}
00805 if SQL <> '' then
00806 SQL := Format(' The SQL: %s; ', [SQL]);
00807 {$ENDIF}
00808
00809 if ErrorMessage <> '' then
00810 begin
00811 DriverManager.LogError(LoggingCategory, PlainDriver.GetProtocol,
00812 ErrorMessage, ErrorCode, ErrorSqlMessage + SQL);
00813
00814 {$IFDEF INTERBASE_EXTENDED_MESSAGES}
00815 raise EZSQLException.CreateWithCode(ErrorCode,
00816 Format('SQL Error: %s. Error Code: %d. %s',
00817 [ErrorMessage, ErrorCode, ErrorSqlMessage]) + SQL);
00818 {$ELSE}
00819 raise EZSQLException.CreateWithCode(ErrorCode,
00820 Format('SQL Error: %s. Error Code: %d. %s',
00821 [ErrorMessage, ErrorCode, ErrorSqlMessage]));
00822 {$ENDIF}
00823 end;
00824 end;
00825 end;
00826
00827 {**
00828 Prepare statement and create statement handle.
00829 @param PlainDriver a interbase plain driver
00830 @param Handle a interbase connection handle
00831 @param TrHandle a transaction handle
00832 @param Dialect a interbase sql dialect number
00833 @param Sql a sql query
00834 @param StmtHandle a statement handle
00835 @param SqlData a interbase sql result data
00836 @return sql statement type
00837 }
00838 function PrepareStatement(PlainDriver: IZInterbasePlainDriver;
00839 Handle: PISC_DB_HANDLE; TrHandle: PISC_TR_HANDLE; Dialect: Word;
00840 SQL: string; var StmtHandle: TISC_STMT_HANDLE):
00841 TZIbSqlStatementType;
00842 var
00843 StatusVector: TARRAY_ISC_STATUS;
00844 begin
00845 { Allocate an sql statement }
00846 PlainDriver.isc_dsql_alloc_statement2(@StatusVector, Handle, @StmtHandle);
00847 CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, Sql);
00848
00849 { Prepare an sql statement }
00850 PlainDriver.isc_dsql_prepare(@StatusVector, TrHandle, @StmtHandle,
00851 0, PChar(SQL), Dialect, nil);
00852 CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, SQL);
00853
00854 { Set Statement Type }
00855 Result := GetStatementType(PlainDriver, StmtHandle);
00856
00857 if Result in [stUnknown, stGetSegment, stPutSegment, stStartTrans] then
00858 begin
00859 FreeStatement(PlainDriver, StmtHandle);
00860 raise EZSQLException.Create(SStatementIsNotAllowed);
00861 end;
00862 end;
00863
00864 {**
00865 Describe SQLDA and allocate memory for result values.
00866 @param PlainDriver a interbase plain driver
00867 @param Handle a interbase connection handle
00868 @param Dialect a interbase sql dialect number
00869 @param Sql a sql query
00870 @param StmtHandle a statement handle
00871 @param SqlData a interbase sql result data
00872 }
00873 procedure PrepareResultSqlData(PlainDriver: IZInterbasePlainDriver;
00874 Handle: PISC_DB_HANDLE; Dialect: Word; SQL: string;
00875 var StmtHandle: TISC_STMT_HANDLE; SqlData: IZResultSQLDA);
00876 var
00877 StatusVector: TARRAY_ISC_STATUS;
00878 begin
00879 { Initialise ouput param and fields }
00880 PlainDriver.isc_dsql_describe(@StatusVector, @StmtHandle, Dialect,
00881 SqlData.GetData);
00882 CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, SQL);
00883
00884 if SqlData.GetData^.sqld > SqlData.GetData^.sqln then
00885 begin
00886 SqlData.AllocateSQLDA;
00887 PlainDriver.isc_dsql_describe(@StatusVector, @StmtHandle,
00888 Dialect, SqlData.GetData);
00889 CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, Sql);
00890 end;
00891 SqlData.InitFields(False);
00892 end;
00893
00894 {**
00895 Return interbase statement type by statement handle
00896 @param PlainDriver a interbase plain driver
00897 @param StmtHandle a statement handle
00898 @return interbase statement type
00899 }
00900 function GetStatementType(PlainDriver: IZInterbasePlainDriver;
00901 StmtHandle: TISC_STMT_HANDLE): TZIbSqlStatementType;
00902 var
00903 TypeItem: Char;
00904 StatusVector: TARRAY_ISC_STATUS;
00905 StatementLength: integer;
00906 StatementBuffer: array [0..7] of Char;
00907 begin
00908 Result := stUnknown;
00909 TypeItem := Char(isc_info_sql_stmt_type);
00910
00911 { Get information about a prepared DSQL statement. }
00912 PlainDriver.isc_dsql_sql_info(@StatusVector, @StmtHandle, 1,
00913 @TypeItem, SizeOf(StatementBuffer), StatementBuffer);
00914 CheckInterbase6Error(PlainDriver, StatusVector);
00915
00916 if StatementBuffer[0] = Char(isc_info_sql_stmt_type) then
00917 begin
00918 StatementLength := PlainDriver.isc_vax_integer(
00919 @StatementBuffer[1], 2);
00920 Result := TZIbSqlStatementType(PlainDriver.isc_vax_integer(
00921 @StatementBuffer[3], StatementLength));
00922 end;
00923 end;
00924
00925 {**
00926 Free interbse allocated statement and SQLDA for input and utput parameters
00927 @param the interbase plain driver
00928 @param the interbse statement handle
00929 }
00930 procedure FreeStatement(PlainDriver: IZInterbasePlainDriver;
00931 StatementHandle: TISC_STMT_HANDLE);
00932 var
00933 StatusVector: TARRAY_ISC_STATUS;
00934 begin
00935 if StatementHandle <> nil then
00936 begin
00937 PlainDriver.isc_dsql_free_statement(@StatusVector, @StatementHandle,
00938 DSQL_drop);
00939 CheckInterbase6Error(PlainDriver, StatusVector);
00940 end;
00941 end;
00942
00943 {**
00944 Get affected rows.
00945 <i>Note:<i> it function may call after statement execution
00946 @param PlainDriver a interbase plain driver
00947 @param StmtHandle a statement handle
00948 @param StatementType a statement type
00949 @return affected rows
00950 }
00951 function GetAffectedRows(PlainDriver: IZInterbasePlainDriver;
00952 StmtHandle: TISC_STMT_HANDLE; StatementType: TZIbSqlStatementType): Integer;
00953 var
00954 ReqInfo: Char;
00955 OutBuffer: array[0..255] of Char;
00956 StatusVector: TARRAY_ISC_STATUS;
00957 begin
00958 Result := -1;
00959 ReqInfo := Char(isc_info_sql_records);
00960
00961 if PlainDriver.isc_dsql_sql_info(@StatusVector, @StmtHandle, 1,
00962 @ReqInfo, SizeOf(OutBuffer), OutBuffer) > 0 then
00963 Exit;
00964 CheckInterbase6Error(PlainDriver, StatusVector);
00965 if OutBuffer[0] = Char(isc_info_sql_records) then
00966 begin
00967 case StatementType of
00968 stUpdate: Result := PlainDriver.isc_vax_integer(@OutBuffer[6], 4);
00969 stDelete: Result := PlainDriver.isc_vax_integer(@OutBuffer[13], 4);
00970 stInsert: Result := PlainDriver.isc_vax_integer(@OutBuffer[27], 4);
00971 else Result := -1;
00972 end;
00973 end;
00974 end;
00975
00976 {**
00977 Prepare sql statement parameters and fill parameters by values
00978 @param PlainDriver a interbase plain driver
00979 @param InParamValues a array of parameters values
00980 @param InParamTypes a array of parameters sql types
00981 @param InParamCount a parameters count
00982 @param Dialect a interbase sql dialect number
00983 @param StmtHandle a statement handle
00984 @param SqlData a interbase sql result data
00985 }
00986 procedure PrepareParameters(PlainDriver: IZInterbasePlainDriver; SQL: string;
00987 InParamValues: TZVariantDynArray; InParamTypes: TZSQLTypeArray; InParamCount: Integer;
00988 Dialect: Word; var StmtHandle: TISC_STMT_HANDLE; ParamSqlData: IZParamsSQLDA);
00989 var
00990 I: Integer;
00991 TempBlob: IZBlob;
00992 TempStream: TStream;
00993 StatusVector: TARRAY_ISC_STATUS;
00994 begin
00995 {check dynamic sql}
00996 PlainDriver.isc_dsql_describe_bind(@StatusVector, @StmtHandle, Dialect,
00997 ParamSqlData.GetData);
00998 CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, SQL);
00999
01000 { Resize XSQLDA structure if needed }
01001 if ParamSqlData.GetData^.sqld > ParamSqlData.GetData^.sqln then
01002 begin
01003 ParamSqlData.AllocateSQLDA;
01004 PlainDriver.isc_dsql_describe_bind(@StatusVector, @StmtHandle, Dialect,
01005 ParamSqlData.GetData);
01006 CheckInterbase6Error(PlainDriver, StatusVector, lcExecute, SQL);
01007 end;
01008
01009 ParamSqlData.InitFields(True);
01010
01011 if InParamCount <> ParamSqlData.GetFieldCount then
01012 raise EZSQLException.Create(SInvalidInputParameterCount);
01013
01014 {$R-}
01015 for I := 0 to ParamSqlData.GetFieldCount-1 do
01016 begin
01017 ParamSQLData.UpdateNull(I, DefVarManager.IsNull(InParamValues[I]));
01018 if DefVarManager.IsNull(InParamValues[I])then
01019 Continue
01020 else
01021 case InParamTypes[I] of
01022 stBoolean:
01023 ParamSqlData.UpdateBoolean(I,
01024 SoftVarManager.GetAsBoolean(InParamValues[I]));
01025 stByte:
01026 ParamSqlData.UpdateByte(I,
01027 SoftVarManager.GetAsInteger(InParamValues[I]));
01028 stShort:
01029 ParamSqlData.UpdateShort(I,
01030 SoftVarManager.GetAsInteger(InParamValues[I]));
01031 stInteger:
01032 ParamSqlData.UpdateInt(I,
01033 SoftVarManager.GetAsInteger(InParamValues[I]));
01034 stLong:
01035 ParamSqlData.UpdateLong(I,
01036 SoftVarManager.GetAsInteger(InParamValues[I]));
01037 stFloat:
01038 ParamSqlData.UpdateFloat(I,
01039 SoftVarManager.GetAsFloat(InParamValues[I]));
01040 stDouble:
01041 ParamSqlData.UpdateDouble(I,
01042 SoftVarManager.GetAsFloat(InParamValues[I]));
01043 stBigDecimal:
01044 ParamSqlData.UpdateBigDecimal(I,
01045 SoftVarManager.GetAsFloat(InParamValues[I]));
01046 stString:
01047 ParamSqlData.UpdateString(I,
01048 SoftVarManager.GetAsString(InParamValues[I]));
01049 stUnicodeString:
01050 ParamSqlData.UpdateString(I,
01051 SoftVarManager.GetAsUnicodeString(InParamValues[I]));
01052 stBytes:
01053 ParamSqlData.UpdateBytes(I,
01054 StrToBytes(SoftVarManager.GetAsString(InParamValues[I])));
01055 stDate:
01056 ParamSqlData.UpdateDate(I,
01057 SoftVarManager.GetAsDateTime(InParamValues[I]));
01058 stTime:
01059 ParamSqlData.UpdateTime(I,
01060 SoftVarManager.GetAsDateTime(InParamValues[I]));
01061 stTimestamp:
01062 ParamSqlData.UpdateTimestamp(I,
01063 SoftVarManager.GetAsDateTime(InParamValues[I]));
01064 stAsciiStream,
01065 stUnicodeStream,
01066 stBinaryStream:
01067 begin
01068 TempBlob := DefVarManager.GetAsInterface(InParamValues[I]) as IZBlob;
01069 if not TempBlob.IsEmpty then
01070 begin
01071 TempStream := TempBlob.GetStream;
01072 try
01073 ParamSqlData.WriteBlob(I, TempStream);
01074 finally
01075 TempStream.Free;
01076 end;
01077 end;
01078 end;
01079 else
01080 raise EZIBConvertError.Create(SUnsupportedParameterType);
01081 end;
01082 end;
01083 {$IFOPT D+}
01084 {$R+}
01085 {$ENDIF}
01086 end;
01087
01088 {**
01089 Read blob information by it handle such as blob segment size, segments count,
01090 blob size and type.
01091 @param PlainDriver
01092 @param BlobInfo the blob information structure
01093 }
01094 procedure GetBlobInfo(PlainDriver: IZInterbasePlainDriver;
01095 BlobHandle: TISC_BLOB_HANDLE; var BlobInfo: TIbBlobInfo);
01096 var
01097 Items: array[0..3] of Char;
01098 Results: array[0..99] of Char;
01099 I, ItemLength: Integer;
01100 Item: Integer;
01101 StatusVector: TARRAY_ISC_STATUS;
01102 begin
01103 I := 0;
01104 Items[0] := Char(isc_info_blob_num_segments);
01105 Items[1] := Char(isc_info_blob_max_segment);
01106 Items[2] := Char(isc_info_blob_total_length);
01107 Items[3] := Char(isc_info_blob_type);
01108
01109 if integer(PlainDriver.isc_blob_info(@StatusVector, @BlobHandle, 4, @items[0],
01110 SizeOf(Results), @Results[0])) > 0 then
01111 CheckInterbase6Error(PlainDriver, StatusVector);
01112
01113 while (I < SizeOf(Results)) and (Results[I] <> Char(isc_info_end)) do
01114 begin
01115 Item := Integer(Results[I]); Inc(I);
01116 ItemLength := PlainDriver.isc_vax_integer(@results[I], 2); Inc(I, 2);
01117 case Item of
01118 isc_info_blob_num_segments:
01119 BlobInfo.NumSegments := PlainDriver.isc_vax_integer(@Results[I], ItemLength);
01120 isc_info_blob_max_segment:
01121 BlobInfo.MaxSegmentSize := PlainDriver.isc_vax_integer(@Results[I], ItemLength);
01122 isc_info_blob_total_length:
01123 BlobInfo.TotalSize := PlainDriver.isc_vax_integer(@Results[I], ItemLength);
01124 isc_info_blob_type:
01125 BlobInfo.BlobType := PlainDriver.isc_vax_integer(@Results[I], ItemLength);
01126 end;
01127 Inc(i, ItemLength);
01128 end;
01129 end;
01130
01131 {**
01132 Read blob field data to stream by it ISC_QUAD value
01133 Note: DefaultBlobSegmentSize constant used for limit segment size reading
01134 @param Handle the database connection handle
01135 @param TransactionHandle the transaction handle
01136 @param BlobId the ISC_QUAD structure
01137 @param Size the result buffer size
01138 @param Buffer the pointer to result buffer
01139
01140 Note: Buffer must be nill. Function self allocate memory for data
01141 and return it size
01142 }
01143 procedure ReadBlobBufer(PlainDriver: IZInterbasePlainDriver;
01144 Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE;
01145 BlobId: TISC_QUAD; var Size: Integer; var Buffer: Pointer);
01146 var
01147 TempBuffer: PChar;
01148 BlobInfo: TIbBlobInfo;
01149 BlobSize, CurPos: LongInt;
01150 BytesRead, SegmentLenght: UShort;
01151 BlobHandle: TISC_BLOB_HANDLE;
01152 StatusVector: TARRAY_ISC_STATUS;
01153 begin
01154 BlobHandle := nil;
01155 CurPos := 0;
01156
01157
01158 { open blob }
01159 PlainDriver.isc_open_blob2(@StatusVector, Handle,
01160 TransactionHandle, @BlobHandle, @BlobId, 0 , nil);
01161 CheckInterbase6Error(PlainDriver, StatusVector);
01162
01163 { get blob info }
01164 GetBlobInfo(PlainDriver, BlobHandle, BlobInfo);
01165 BlobSize := BlobInfo.TotalSize;
01166 Size := BlobSize;
01167
01168 SegmentLenght := BlobInfo.MaxSegmentSize;
01169
01170 { Allocates a blob buffer }
01171 Buffer := AllocMem(BlobSize);
01172 TempBuffer := Buffer;
01173
01174 { Copies data to blob buffer }
01175 while CurPos < BlobSize do
01176 begin
01177 if (CurPos + SegmentLenght > BlobSize) then
01178 SegmentLenght := BlobSize - CurPos;
01179 if not(PlainDriver.isc_get_segment(@StatusVector, @BlobHandle,
01180 @BytesRead, SegmentLenght, TempBuffer) = 0) or
01181 (StatusVector[1] <> isc_segment) then
01182 CheckInterbase6Error(PlainDriver, StatusVector);
01183 Inc(CurPos, BytesRead);
01184 Inc(TempBuffer, BytesRead);
01185 BytesRead := 0;
01186 end;
01187
01188 { close blob handle }
01189 PlainDriver.isc_close_blob(@StatusVector, @BlobHandle);
01190 CheckInterbase6Error(PlainDriver, StatusVector);
01191 end;
01192
01193 {**
01194 Return interbase server version string
01195 @param PlainDriver a interbase plain driver
01196 @param Handle the database connection handle
01197 @return interbase version string
01198 }
01199 function GetVersion(PlainDriver: IZInterbasePlainDriver;
01200 Handle: PISC_DB_HANDLE): String;
01201 var
01202 DatabaseInfoCommand: Char;
01203 StatusVector: TARRAY_ISC_STATUS;
01204 Buffer: array[0..IBBigLocalBufferLength - 1] of Char;
01205 begin
01206 DatabaseInfoCommand := Char(isc_info_version);
01207 PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand,
01208 IBBigLocalBufferLength, Buffer);
01209 CheckInterbase6Error(PlainDriver, StatusVector);
01210 Buffer[5 + Integer(Buffer[4])] := #0;
01211 result := String(PChar(@Buffer[5]));
01212 end;
01213
01214 {**
01215 Return interbase database implementation
01216 @param PlainDriver a interbase plain driver
01217 @param Handle the database connection handle
01218 @return interbase database implementation
01219 }
01220 function GetDBImplementationNo(PlainDriver: IZInterbasePlainDriver;
01221 Handle: PISC_DB_HANDLE): LongInt;
01222 var
01223 DatabaseInfoCommand: Char;
01224 StatusVector: TARRAY_ISC_STATUS;
01225 Buffer: array[0..IBBigLocalBufferLength - 1] of Char;
01226 begin
01227 DatabaseInfoCommand := Char(isc_info_implementation);
01228 PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand,
01229 IBLocalBufferLength, Buffer);
01230 CheckInterbase6Error(PlainDriver, StatusVector);
01231 result := PlainDriver.isc_vax_integer(@Buffer[3], 1);
01232 end;
01233
01234 {**
01235 Return interbase database implementation class
01236 @param PlainDriver a interbase plain driver
01237 @param Handle the database connection handle
01238 @return interbase database implementation class
01239 }
01240 function GetDBImplementationClass(PlainDriver: IZInterbasePlainDriver;
01241 Handle: PISC_DB_HANDLE): LongInt;
01242 var
01243 DatabaseInfoCommand: Char;
01244 StatusVector: TARRAY_ISC_STATUS;
01245 Buffer: array[0..IBBigLocalBufferLength - 1] of Char;
01246 begin
01247 DatabaseInfoCommand := Char(isc_info_implementation);
01248 PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand,
01249 IBLocalBufferLength, Buffer);
01250 CheckInterbase6Error(PlainDriver, StatusVector);
01251 result := PlainDriver.isc_vax_integer(@Buffer[4], 1);
01252 end;
01253
01254 {**
01255 Return interbase database info
01256 @param PlainDriver a interbase plain driver
01257 @param Handle the database connection handle
01258 @param DatabaseInfoCommand a database information command
01259 @return interbase database info
01260 }
01261 function GetLongDbInfo(PlainDriver: IZInterbasePlainDriver;
01262 Handle: PISC_DB_HANDLE; DatabaseInfoCommand: Integer): LongInt;
01263 var
01264 Length: Integer;
01265 DatabaseInfoCommand1: Char;
01266 StatusVector: TARRAY_ISC_STATUS;
01267 Buffer: array[0..IBBigLocalBufferLength - 1] of Char;
01268 begin
01269 DatabaseInfoCommand1 := Char(DatabaseInfoCommand);
01270 PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand1,
01271 IBLocalBufferLength, Buffer);
01272 CheckInterbase6Error(PlainDriver, StatusVector);
01273 Length := PlainDriver.isc_vax_integer(@Buffer[1], 2);
01274 Result := PlainDriver.isc_vax_integer(@Buffer[4], Length);
01275 end;
01276
01277 {**
01278 Return interbase database info string
01279 @param PlainDriver a interbase plain driver
01280 @param Handle a database connection handle
01281 @param DatabaseInfoCommand a database information command
01282 @return interbase database info string
01283 }
01284 function GetStringDbInfo(PlainDriver: IZInterbasePlainDriver;
01285 Handle: PISC_DB_HANDLE; DatabaseInfoCommand: Integer): String;
01286 var
01287 DatabaseInfoCommand1: Char;
01288 StatusVector: TARRAY_ISC_STATUS;
01289 Buffer: array[0..IBBigLocalBufferLength - 1] of Char;
01290 begin
01291 DatabaseInfoCommand1 := Char(DatabaseInfoCommand);
01292 PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand1,
01293 IBLocalBufferLength, Buffer);
01294 CheckInterbase6Error(PlainDriver, StatusVector);
01295 Buffer[4 + Integer(Buffer[3])] := #0;
01296 Result := String(PChar(@Buffer[4]));
01297 end;
01298
01299 {**
01300 Return interbase database dialect
01301 @param PlainDriver a interbase plain driver
01302 @param Handle the database connection handle
01303 @return interbase database dialect
01304 }
01305 function GetDBSQLDialect(PlainDriver: IZInterbasePlainDriver;
01306 Handle: PISC_DB_HANDLE): Integer;
01307 var
01308 Length: Integer;
01309 DatabaseInfoCommand1: Char;
01310 StatusVector: TARRAY_ISC_STATUS;
01311 Buffer: array[0..IBBigLocalBufferLength - 1] of Char;
01312 begin
01313 DatabaseInfoCommand1 := Char(isc_info_db_SQL_Dialect);
01314 PlainDriver.isc_database_info(@StatusVector, Handle, 1, @DatabaseInfoCommand1,
01315 IBLocalBufferLength, Buffer);
01316 CheckInterbase6Error(PlainDriver, StatusVector);
01317 if (Buffer[0] <> Char(isc_info_db_SQL_dialect)) then
01318 Result := 1
01319 else begin
01320 Length := PlainDriver.isc_vax_integer(@Buffer[1], 2);
01321 Result := PlainDriver.isc_vax_integer(@Buffer[3], Length);
01322 end;
01323 end;
01324
01325 { TSQLDA }
01326
01327 {**
01328 Allocate memory for SQLVar in SQLDA structure for every
01329 fields by it length.
01330 }
01331 procedure TZSQLDA.InitFields(Parameters: boolean);
01332 var
01333 I: Integer;
01334 SqlVar: PXSQLVAR;
01335 begin
01336 {$R-}
01337 for I := 0 to FXSQLDA.sqld - 1 do
01338 begin
01339 SqlVar := @FXSQLDA.SqlVar[I];
01340 case SqlVar.sqltype and (not 1) of
01341 SQL_BOOLEAN, SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_DATE,
01342 SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
01343 SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
01344 begin
01345 if SqlVar.sqllen = 0 then
01346 IbReAlloc(SqlVar.sqldata, 0, 1)
01347 else
01348 IbReAlloc(SqlVar.sqldata, 0, SqlVar.sqllen)
01349 end;
01350 SQL_VARYING:
01351 IbReAlloc(SqlVar.sqldata, 0, SqlVar.sqllen + 2)
01352 end;
01353
01354 if Parameters = True then
01355 begin
01356
01357 SqlVar.sqltype := SqlVar.sqltype or 1;
01358 IbReAlloc(SqlVar.sqlind, 0, SizeOf(Short))
01359 end else begin
01360
01361 if (SqlVar.sqltype and 1) <> 0 then
01362 ReallocMem(SqlVar.sqlind, SizeOf(Short))
01363 else
01364 SqlVar.sqlind := nil;
01365 end;
01366 end;
01367 {$IFOPT D+}
01368 {$R+}
01369 {$ENDIF}
01370 end;
01371
01372 {**
01373 Clear allocated data for SQLDA paramters
01374 }
01375 procedure TZSQLDA.FreeParamtersValues;
01376 var
01377 I: Integer;
01378 SqlVar: PXSQLVAR;
01379 begin
01380 {$R-}
01381 for I := 0 to FXSQLDA.sqln - 1 do
01382 begin
01383 SqlVar := @FXSQLDA.SqlVar[I];
01384 FreeMem(SqlVar.sqldata);
01385 FreeMem(SqlVar.sqlind);
01386 SqlVar.sqldata := nil;
01387 SqlVar.sqlind := nil;
01388 end;
01389 {$IFOPT D+}
01390 {$R+}
01391 {$ENDIF}
01392 end;
01393
01394 {**
01395 Chech reange count fields. If index out of range raised exception.
01396 @param Index the index field
01397 }
01398 procedure TZSQLDA.CheckRange(const Index: Word);
01399 begin
01400 Assert(Index < Word(FXSQLDA.sqln), 'Out of Range.');
01401 end;
01402
01403 {**
01404 Return alias name for field
01405 @param Index the index fields
01406 @return the alias name
01407 }
01408 function TZSQLDA.GetFieldAliasName(const Index: Word): string;
01409 begin
01410 CheckRange(Index);
01411 {$R-}
01412 SetString(Result, FXSQLDA.sqlvar[Index].aliasname,
01413 FXSQLDA.sqlvar[Index].aliasname_length);
01414 {$IFOPT D+}
01415 {$R+}
01416 {$ENDIF}
01417 end;
01418
01419 {**
01420 Return pointer to SQLDA structure
01421 }
01422 function TZSQLDA.GetData: PXSQLDA;
01423 begin
01424 result := FXSQLDA;
01425 end;
01426
01427 {**
01428 Get fields count not allocated.
01429 @return fields count
01430 }
01431 function TZSQLDA.GetFieldCount: Integer;
01432 begin
01433 Result := FXSQLDA.sqld;
01434 end;
01435
01436 {**
01437 Return field index by it name
01438 @param Index the index fields
01439 @return the index field
01440 }
01441 function TZSQLDA.GetFieldIndex(const Name: String): Word;
01442 begin
01443 {$R-}
01444 for Result := 0 to GetFieldCount - 1 do
01445 if FXSQLDA.sqlvar[Result].aliasname_length = Length(name) then
01446 if StrLIComp(@FXSQLDA.sqlvar[Result].aliasname, PChar(Name),
01447 FXSQLDA.sqlvar[Result].aliasname_length) = 0 then Exit;
01448 raise Exception.Create(Format(SFieldNotFound1, [name]));
01449 {$IFOPT D+}
01450 {$R+}
01451 {$ENDIF}
01452 end;
01453
01454 {**
01455 Return field length
01456 @param Index the index fields
01457 @return the field lenth
01458 }
01459 function TZSQLDA.GetFieldLength(const Index: Word): SmallInt;
01460 begin
01461 {$R-}
01462 case GetIbSqlType(Index) of
01463 SQL_TEXT: Result := GetIbSqlLen(Index);
01464 SQL_VARYING: Result := GetIbSqlLen(Index);
01465
01466 else
01467 Result := GetIbSqlLen(Index);
01468 end;
01469 {$IFOPT D+}
01470 {$R+}
01471 {$ENDIF}
01472 end;
01473
01474 {**
01475 Return field scale
01476 @param Index the index fields
01477 @return the field scale
01478 }
01479 function TZSQLDA.GetFieldScale(const Index: Word): integer;
01480 begin
01481 CheckRange(Index);
01482 {$R-}
01483 Result := Abs(FXSQLDA.sqlvar[Index].sqlscale);
01484 {$IFOPT D+}
01485 {$R+}
01486 {$ENDIF}
01487 end;
01488
01489 {**
01490 Convert Interbase sql type to SQLType
01491 @param Index the index fields
01492 @return the SQLType
01493 }
01494 function TZSQLDA.GetFieldSqlType(const Index: Word): TZSQLType;
01495 var
01496 SqlScale: Integer;
01497 SqlSubType: Integer;
01498 begin
01499 SqlScale := GetFieldScale(Index);
01500 SqlSubType := GetIbSqlSubType(Index);
01501
01502 case GetIbSqlType(Index) of
01503 SQL_VARYING, SQL_TEXT: Result := stString;
01504 SQL_LONG:
01505 begin
01506 if SqlScale = 0 then
01507 Result := stInteger
01508 else
01509 Result := stDouble;
01510 end;
01511 SQL_SHORT:
01512 begin
01513 if SqlScale = 0 then
01514 Result := stShort
01515 else
01516 Result := stdouble;
01517 end;
01518 SQL_FLOAT, SQL_DOUBLE: Result := stDouble;
01519 SQL_DATE: Result := stTimestamp;
01520 SQL_TYPE_TIME: Result := stTime;
01521 SQL_TYPE_DATE: Result := stDate;
01522 SQL_INT64:
01523 begin
01524 if SqlScale = 0 then
01525 Result := stLong
01526 else if Abs(SqlScale) <= 4 then
01527 Result := stDouble
01528 else
01529 Result := stBigDecimal;
01530 end;
01531 SQL_QUAD, SQL_ARRAY, SQL_BLOB:
01532 begin
01533 if SqlSubType = isc_blob_text then
01534 Result := stAsciiStream
01535 else Result := stBinaryStream;
01536 end;
01537
01538 else Result := stString;
01539 end;
01540 end;
01541
01542 {**
01543 Return own name for field
01544 @param Index the index fields
01545 @return the own name
01546 }
01547 function TZSQLDA.GetFieldOwnerName(const Index: Word): string;
01548 begin
01549 CheckRange(Index);
01550 {$R-}
01551 SetString(Result, FXSQLDA.sqlvar[Index].OwnName,
01552 FXSQLDA.sqlvar[Index].OwnName_length);
01553 {$IFOPT D+}
01554 {$R+}
01555 {$ENDIF}
01556 end;
01557
01558 {**
01559 Return real name for field
01560 @param Index the index fields
01561 @return the real name
01562 }
01563 function TZSQLDA.GetFieldRelationName(const Index: Word): string;
01564 begin
01565 CheckRange(Index);
01566 {$R-}
01567 SetString(Result, FXSQLDA.sqlvar[Index].RelName,
01568 FXSQLDA.sqlvar[Index].RelName_length);
01569 {$IFOPT D+}
01570 {$R+}
01571 {$ENDIF}
01572 end;
01573
01574 {**
01575 Get Interbase sql fields lenth
01576 @param Index the index fields
01577 @return Interbase sql fields lenth
01578 }
01579 function TZSQLDA.GetIbSqlLen(const Index: Word): Smallint;
01580 begin
01581 CheckRange(Index);
01582 {$R-}
01583 result := FXSQLDA.sqlvar[Index].sqllen;
01584 {$IFOPT D+}
01585 {$R+}
01586 {$ENDIF}
01587 end;
01588
01589 {**
01590 Return sql name for field
01591 @param Index the index fields
01592 @return the sql name
01593 }
01594 function TZSQLDA.GetFieldSqlName(const Index: Word): string;
01595 begin
01596 CheckRange(Index);
01597 {$R-}
01598 SetString(Result, FXSQLDA.sqlvar[Index].sqlname,
01599 FXSQLDA.sqlvar[Index].sqlname_length);
01600 {$IFOPT D+}
01601 {$R+}
01602 {$ENDIF}
01603 end;
01604
01605 {**
01606 Get Interbase subsql type
01607 @param Index the index fields
01608 @return the Interbase subsql
01609 }
01610 function TZSQLDA.GetIbSqlSubType(const Index: Word): Smallint;
01611 begin
01612 CheckRange(Index);
01613 {$R-}
01614 result := FXSQLDA.sqlvar[Index].sqlsubtype;
01615 {$IFOPT D+}
01616 {$R+}
01617 {$ENDIF}
01618 end;
01619
01620 {**
01621 Get Interbase sql type
01622 @param Index the index fields
01623 @return the interbase sql type
01624 }
01625 function TZSQLDA.GetIbSqlType(const Index: Word): Smallint;
01626 begin
01627 CheckRange(Index);
01628 {$R-}
01629 result := FXSQLDA.sqlvar[Index].sqltype and not (1);
01630 {$IFOPT D+}
01631 {$R+}
01632 {$ENDIF}
01633 end;
01634
01635 {**
01636 Reallocate memory and fill memory by #0
01637 @param pointer to memory block
01638 @param old size of memory block
01639 @param new size of memory block
01640 }
01641 procedure TZSQLDA.IbReAlloc(var P; OldSize, NewSize: Integer);
01642 begin
01643 ReallocMem(Pointer(P), NewSize);
01644 if NewSize > OldSize then
01645 Fillchar((Pchar(P) + OldSize)^, NewSize - OldSize, #0);
01646 end;
01647
01648 procedure TZSQLDA.SetFieldType(const Index: Word; Size: Integer; Code: Smallint;
01649 Scale: Smallint);
01650 begin
01651 CheckRange(Index);
01652 {$R-}
01653 with FXSQLDA.sqlvar[Index] do
01654 begin
01655 sqltype := Code;
01656 if Scale <= 0 then
01657 sqlscale := Scale;
01658 sqllen := Size;
01659 if (Size > 0) then
01660 IbReAlloc(sqldata, 0, Size)
01661 else
01662 begin
01663 FreeMem(sqldata);
01664 sqldata := nil;
01665 end;
01666 end;
01667 {$IFOPT D+}
01668 {$R+}
01669 {$ENDIF}
01670 end;
01671
01672 {**
01673 Indicate blob field
01674 @param Index the index fields
01675 @return true if blob field overwise false
01676 }
01677 function TZSQLDA.IsBlob(const Index: Word): boolean;
01678 begin
01679 CheckRange(Index);
01680 {$R-}
01681 result := ((FXSQLDA.sqlvar[Index].sqltype and not(1)) = SQL_BLOB);
01682 {$IFOPT D+}
01683 {$R+}
01684 {$ENDIF}
01685 end;
01686
01687 {**
01688 Indicate blob field
01689 @param Index the index fields
01690 @return true if field nullable overwise false
01691 }
01692 function TZSQLDA.IsNullable(const Index: Word): boolean;
01693 begin
01694 CheckRange(Index);
01695 {$R-}
01696 Result := FXSQLDA.sqlvar[Index].sqltype and 1 = 1
01697 {$IFOPT D+}
01698 {$R+}
01699 {$ENDIF}
01700 end;
01701
01702 {**
01703 Reallocate SQLDA to fields count length
01704 @param Value the count fields
01705 }
01706 procedure TZSQLDA.AllocateSQLDA;
01707 begin
01708 IbReAlloc(FXSQLDA, XSQLDA_LENGTH(FXSQLDA.sqln), XSQLDA_LENGTH(FXSQLDA.sqld));
01709 FXSQLDA.sqln := FXSQLDA.sqld;
01710 end;
01711
01712 { TParamsSQLDA }
01713
01714 {**
01715 Constructs this object and assignes the main properties.
01716 param PlainDriver the interbase plain driver
01717 }
01718 constructor TZParamsSQLDA.Create(PlainDriver: IZInterbasePlainDriver;
01719 Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE);
01720 begin
01721 FPlainDriver := PlainDriver;
01722 FHandle := Handle;
01723 FTransactionHandle := TransactionHandle;
01724
01725 GetMem(FXSQLDA, XSQLDA_LENGTH(0));
01726 FillChar(FXSQLDA^, XSQLDA_LENGTH(0), 0);
01727 FXSQLDA.sqln := 0;
01728 FXSQLDA.sqld := 0;
01729
01730 FXSQLDA.version := SQLDA_VERSION1;
01731 end;
01732
01733 {**
01734 Free allocated memory and free object
01735 }
01736 destructor TZParamsSQLDA.Destroy;
01737 begin
01738 FreeParamtersValues;
01739 FreeMem(FXSQLDA);
01740 inherited Destroy;
01741 end;
01742
01743 {**
01744 Encode pascal string to Interbase paramter buffer
01745 @param Code the Interbase data type
01746 @param Index the index target filed
01747 @param Str the source string
01748 }
01749 procedure TZParamsSQLDA.EncodeString(Code: Smallint; const Index: Word;
01750 const Str: String);
01751 var
01752 Len: Cardinal;
01753 begin
01754 Len := Length(Str);
01755 {$R-}
01756 with FXSQLDA.sqlvar[Index] do
01757 case Code of
01758 SQL_TEXT :
01759 begin
01760 if sqllen = 0 then
01761 GetMem(sqldata, Len)
01762 else
01763 IbReAlloc(sqldata, 0, Len + 1);
01764 sqllen := Len;
01765 Move(PChar(str)^, sqldata^, sqllen);
01766 end;
01767 SQL_VARYING :
01768 begin
01769 if sqllen = 0 then
01770 GetMem(sqldata, Len + 2)
01771 else
01772 IbReAlloc(sqldata, 0, Len + 2);
01773 sqllen := Len + 2;
01774 PISC_VARYING(sqldata).strlen := Len;
01775 Move(PChar(str)^, PISC_VARYING(sqldata).str,
01776 PISC_VARYING(sqldata).strlen);
01777 end;
01778 end;
01779 {$IFOPT D+}
01780 {$R+}
01781 {$ENDIF}
01782 end;
01783
01784 {**
01785 Set up parameter BigDecimal value
01786 @param Index the target parameter index
01787 @param Value the source value
01788 }
01789 procedure TZParamsSQLDA.UpdateBigDecimal(const Index: Integer; Value: Extended);
01790 var
01791 SQLCode: SmallInt;
01792 begin
01793 CheckRange(Index);
01794 SetFieldType(Index, sizeof(Int64), SQL_INT64 + 1, -4);
01795 {$R-}
01796 with FXSQLDA.sqlvar[Index] do
01797 begin
01798 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
01799 SQLCode := (sqltype and not(1));
01800
01801 if (sqlscale < 0) then
01802 begin
01803 case SQLCode of
01804 SQL_SHORT : PSmallInt(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
01805 SQL_LONG : PInteger(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
01806 SQL_INT64,
01807 SQL_QUAD : PInt64(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
01808 SQL_DOUBLE : PDouble(sqldata)^ := Value;
01809 else
01810 raise EZIBConvertError.Create(SUnsupportedDataType);
01811 end;
01812 end else
01813 case SQLCode of
01814 SQL_DOUBLE : PDouble(sqldata)^ := Value;
01815 SQL_LONG : PInteger(sqldata)^ := Trunc(Value);
01816 SQL_D_FLOAT,
01817 SQL_FLOAT : PSingle(sqldata)^ := Value;
01818 SQL_BOOLEAN : PSmallint(sqldata)^ := Trunc(Value);
01819 SQL_SHORT : PSmallint(sqldata)^ := Trunc(Value);
01820 SQL_INT64 : PInt64(sqldata)^ := Trunc(Value);
01821 SQL_TEXT : EncodeString(SQL_TEXT, Index, FloatToStr(Value));
01822 SQL_VARYING : EncodeString(SQL_VARYING, Index, FloatToStr(Value));
01823 else
01824 raise EZIBConvertError.Create(SUnsupportedDataType);
01825 end;
01826 if (sqlind <> nil) then sqlind^ := 0;
01827 end;
01828 {$IFOPT D+}
01829 {$R+}
01830 {$ENDIF}
01831 end;
01832
01833 {**
01834 Set up parameter Boolean value
01835 @param Index the target parameter index
01836 @param Value the source value
01837 }
01838 procedure TZParamsSQLDA.UpdateBoolean(const Index: Integer; Value: boolean);
01839 var
01840 SQLCode: SmallInt;
01841 begin
01842 CheckRange(Index);
01843 {$R-}
01844 with FXSQLDA.sqlvar[Index] do
01845 begin
01846 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
01847 SQLCode := (sqltype and not(1));
01848
01849 if (sqlscale < 0) then
01850 begin
01851 case SQLCode of
01852 SQL_SHORT : PSmallInt(sqldata)^ := ord(Value) * IBScaleDivisor[sqlscale];
01853 SQL_LONG : PInteger(sqldata)^ := ord(Value) * IBScaleDivisor[sqlscale];
01854 SQL_INT64,
01855 SQL_QUAD : PInt64(sqldata)^ := ord(Value) * IBScaleDivisor[sqlscale];
01856 SQL_DOUBLE : PDouble(sqldata)^ := ord(Value);
01857 else
01858 raise EZIBConvertError.Create(SUnsupportedParameterType);
01859 end;
01860 end else
01861 case SQLCode of
01862 SQL_DOUBLE : PDouble(sqldata)^ := ord(Value);
01863 SQL_LONG : PInteger(sqldata)^ := ord(Value);
01864 SQL_D_FLOAT,
01865 SQL_FLOAT : PSingle(sqldata)^ := ord(Value);
01866 SQL_BOOLEAN : PSmallint(sqldata)^ := ord(Value);
01867 SQL_SHORT : PSmallint(sqldata)^ := ord(Value);
01868 SQL_INT64 : PInt64(sqldata)^ := ord(Value);
01869 SQL_TEXT : EncodeString(SQL_TEXT, Index, IntToStr(ord(Value)));
01870 SQL_VARYING : EncodeString(SQL_VARYING, Index, IntToStr(ord(Value)));
01871 else
01872 raise EZIBConvertError.Create(SUnsupportedParameterType);
01873 end;
01874 if (sqlind <> nil) then sqlind^ := 0;
01875 end;
01876 {$IFOPT D+}
01877 {$R+}
01878 {$ENDIF}
01879 end;
01880
01881 {**
01882 Set up parameter Byte value
01883 @param Index the target parameter index
01884 @param Value the source value
01885 }
01886 procedure TZParamsSQLDA.UpdateByte(const Index: Integer; Value: ShortInt);
01887 var
01888 SQLCode: SmallInt;
01889 begin
01890 CheckRange(Index);
01891 SetFieldType(Index, sizeof(Smallint), SQL_SHORT + 1, 0);
01892 {$R-}
01893 with FXSQLDA.sqlvar[Index] do
01894 begin
01895 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
01896 SQLCode := (sqltype and not(1));
01897
01898 if (sqlscale < 0) then
01899 begin
01900 case SQLCode of
01901 SQL_SHORT : PSmallInt(sqldata)^ := Value * IBScaleDivisor[sqlscale];
01902 SQL_LONG : PInteger(sqldata)^ := Value * IBScaleDivisor[sqlscale];
01903 SQL_INT64,
01904 SQL_QUAD : PInt64(sqldata)^ := Value * IBScaleDivisor[sqlscale];
01905 SQL_DOUBLE : PDouble(sqldata)^ := Value;
01906 else
01907 raise EZIBConvertError.Create(SUnsupportedParameterType);
01908 end;
01909 end else
01910 case SQLCode of
01911 SQL_DOUBLE : PDouble(sqldata)^ := Value;
01912 SQL_LONG : PInteger(sqldata)^ := Value;
01913 SQL_D_FLOAT,
01914 SQL_FLOAT : PSingle(sqldata)^ := Value;
01915 SQL_BOOLEAN: begin
01916 if FPlainDriver.GetProtocol <> 'interbase-7' then
01917 raise EZIBConvertError.Create(SUnsupportedDataType);
01918 PSmallint(sqldata)^ := Value;
01919 end;
01920 SQL_SHORT : PSmallint(sqldata)^ := Value;
01921 SQL_INT64 : PInt64(sqldata)^ := Value;
01922 SQL_TEXT : EncodeString(SQL_TEXT, Index, IntToStr(Value));
01923 SQL_VARYING : EncodeString(SQL_VARYING, Index, IntToStr(Value));
01924 else
01925 raise EZIBConvertError.Create(SUnsupportedParameterType);
01926 end;
01927 if (sqlind <> nil) then sqlind^ := 0;
01928 end;
01929 {$IFOPT D+}
01930 {$R+}
01931 {$ENDIF}
01932 end;
01933
01934 {**
01935 Set up parameter byte value
01936 @param Index the target parameter index
01937 @param Value the source value
01938 }
01939 procedure TZParamsSQLDA.UpdateBytes(const Index: Integer; Value: TByteDynArray);
01940 begin
01941
01942 end;
01943
01944 {**
01945 Set up parameter Date value
01946 @param Index the target parameter index
01947 @param Value the source value
01948 }
01949 procedure TZParamsSQLDA.UpdateDate(const Index: Integer; Value: TDateTime);
01950 begin
01951 SetFieldType(Index, sizeof(Integer), SQL_TYPE_DATE + 1, 0);
01952 UpdateDateTime(Index, Value);
01953 end;
01954
01955 {**
01956 Set up parameter DateTime value
01957 @param Index the target parameter index
01958 @param Value the source value
01959 }
01960 procedure TZParamsSQLDA.UpdateDateTime(const Index: Integer;
01961 Value: TDateTime);
01962 var
01963 y, m, d: word;
01964 hr, min, sec, msec: word;
01965 SQLCode: SmallInt;
01966 TmpDate: TCTimeStructure;
01967 begin
01968 CheckRange(Index);
01969 {$R-}
01970 with FXSQLDA.sqlvar[Index] do
01971 begin
01972 DecodeDate(Value, y, m, d);
01973 DecodeTime(Value, hr, min, sec, msec);
01974 TmpDate.tm_year := y - 1900;
01975 TmpDate.tm_mon := m - 1;
01976 TmpDate.tm_mday := d;
01977 TmpDate.tm_hour := hr;
01978 TmpDate.tm_min := min;
01979 TmpDate.tm_sec := sec;
01980 TmpDate.tm_wday := 0;
01981 TmpDate.tm_yday := 0;
01982 TmpDate.tm_isdst := 0;
01983
01984 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
01985 SQLCode := (sqltype and not(1));
01986
01987 case SQLCode of
01988 SQL_TYPE_DATE : FPlainDriver.isc_encode_sql_date(@TmpDate, PISC_DATE(sqldata));
01989 SQL_TYPE_TIME : FPlainDriver.isc_encode_sql_time(@TmpDate, PISC_TIME(sqldata));
01990 SQL_TIMESTAMP :
01991 FPlainDriver.isc_encode_date(@TmpDate, PISC_QUAD(sqldata));
01992 else
01993 raise EZIBConvertError.Create(SInvalidState);
01994 end;
01995 if (sqlind <> nil) then sqlind^ := 0;
01996 end;
01997 {$IFOPT D+}
01998 {$R+}
01999 {$ENDIF}
02000 end;
02001
02002 {**
02003 Set up parameter Double value
02004 @param Index the target parameter index
02005 @param Value the source value
02006 }
02007 procedure TZParamsSQLDA.UpdateDouble(const Index: Integer; Value: Double);
02008 var
02009 SQLCode: SmallInt;
02010 begin
02011 CheckRange(Index);
02012 SetFieldType(Index, sizeof(double), SQL_DOUBLE + 1, 0);
02013 {$R-}
02014 with FXSQLDA.sqlvar[Index] do
02015 begin
02016 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02017 SQLCode := (sqltype and not(1));
02018
02019 if (sqlscale < 0) then
02020 begin
02021 case SQLCode of
02022 SQL_SHORT : PSmallInt(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
02023 SQL_LONG : PInteger(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
02024 SQL_INT64,
02025 SQL_QUAD : PInt64(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
02026 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02027 else
02028 raise EZIBConvertError.Create(SUnsupportedDataType);
02029 end;
02030 end else
02031 case SQLCode of
02032 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02033 SQL_LONG : PInteger(sqldata)^ := Trunc(Value);
02034 SQL_D_FLOAT,
02035 SQL_FLOAT : PSingle(sqldata)^ := Value;
02036 SQL_BOOLEAN : PSmallint(sqldata)^ := Trunc(Value);
02037 SQL_SHORT : PSmallint(sqldata)^ := Trunc(Value);
02038 SQL_INT64 : PInt64(sqldata)^ := Trunc(Value);
02039 SQL_TEXT : EncodeString(SQL_TEXT, Index, FloatToStr(Value));
02040 SQL_VARYING : EncodeString(SQL_VARYING, Index, FloatToStr(Value));
02041 else
02042 raise EZIBConvertError.Create(SUnsupportedDataType);
02043 end;
02044 if (sqlind <> nil) then sqlind^ := 0;
02045 end;
02046 {$IFOPT D+}
02047 {$R+}
02048 {$ENDIF}
02049 end;
02050
02051 {**
02052 Set up parameter Float value
02053 @param Index the target parameter index
02054 @param Value the source value
02055 }
02056 procedure TZParamsSQLDA.UpdateFloat(const Index: Integer; Value: Single);
02057 var
02058 SQLCode: SmallInt;
02059 begin
02060 CheckRange(Index);
02061 SetFieldType(Index, sizeof(Single), SQL_FLOAT + 1, 1);
02062 {$R-}
02063 with FXSQLDA.sqlvar[Index] do
02064 begin
02065 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02066 SQLCode := (sqltype and not(1));
02067
02068 if (sqlscale < 0) then
02069 begin
02070 case SQLCode of
02071 SQL_SHORT : PSmallInt(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
02072 SQL_LONG : PInteger(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
02073 SQL_INT64,
02074 SQL_QUAD : PInt64(sqldata)^ := Trunc(Value * IBScaleDivisor[sqlscale]);
02075 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02076 SQL_D_FLOAT,
02077 SQL_FLOAT : PSingle(sqldata)^ := Value;
02078 else
02079 raise EZIBConvertError.Create(SUnsupportedDataType);
02080 end;
02081 end else
02082 case SQLCode of
02083 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02084 SQL_LONG : PInteger(sqldata)^ := Trunc(Value);
02085 SQL_D_FLOAT,
02086 SQL_FLOAT : PSingle(sqldata)^ := Value;
02087 SQL_BOOLEAN : PSmallint(sqldata)^ := Trunc(Value);
02088 SQL_SHORT : PSmallint(sqldata)^ := Trunc(Value);
02089 SQL_INT64 : PInt64(sqldata)^ := Trunc(Value);
02090 SQL_TEXT : EncodeString(SQL_TEXT, Index, FloatToStr(Value));
02091 SQL_VARYING : EncodeString(SQL_VARYING, Index, FloatToStr(Value));
02092 else
02093 raise EZIBConvertError.Create(SUnsupportedDataType);
02094 end;
02095 if (sqlind <> nil) then sqlind^ := 0;
02096 end;
02097 {$IFOPT D+}
02098 {$R+}
02099 {$ENDIF}
02100 end;
02101
02102 {**
02103 Set up parameter integer value
02104 @param Index the target parameter index
02105 @param Value the source value
02106 }
02107 procedure TZParamsSQLDA.UpdateInt(const Index: Integer; Value: Integer);
02108 var
02109 SQLCode: SmallInt;
02110 begin
02111 CheckRange(Index);
02112 SetFieldType(Index, sizeof(Integer), SQL_LONG + 1, 0);
02113 {$R-}
02114 with FXSQLDA.sqlvar[Index] do
02115 begin
02116 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02117 SQLCode := (sqltype and not(1));
02118
02119 if (sqlscale < 0) then
02120 begin
02121 case SQLCode of
02122 SQL_SHORT : PSmallInt(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02123 SQL_LONG : PInteger(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02124 SQL_INT64,
02125 SQL_QUAD : PInt64(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02126 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02127 else
02128 raise EZIBConvertError.Create(SUnsupportedDataType);
02129 end;
02130 end else
02131 case SQLCode of
02132 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02133 SQL_LONG : PInteger(sqldata)^ := Value;
02134 SQL_D_FLOAT,
02135 SQL_FLOAT : PSingle(sqldata)^ := Value;
02136 SQL_BOOLEAN : PSmallint(sqldata)^ := Value;
02137 SQL_SHORT : PSmallint(sqldata)^ := Value;
02138 SQL_INT64 : PInt64(sqldata)^ := Value;
02139 SQL_TEXT : EncodeString(SQL_TEXT, Index, IntToStr(Value));
02140 SQL_VARYING : EncodeString(SQL_VARYING, Index, IntToStr(Value));
02141 else
02142 raise EZIBConvertError.Create(SUnsupportedDataType);
02143 end;
02144 if (sqlind <> nil) then sqlind^ := 0;
02145 end;
02146 {$IFOPT D+}
02147 {$R+}
02148 {$ENDIF}
02149 end;
02150
02151 {**
02152 Set up parameter Long value
02153 @param Index the target parameter index
02154 @param Value the source value
02155 }
02156 procedure TZParamsSQLDA.UpdateLong(const Index: integer; Value: Int64);
02157 var
02158 SQLCode: SmallInt;
02159 begin
02160 CheckRange(Index);
02161 SetFieldType(Index, sizeof(Int64), SQL_INT64 + 1, 0);
02162 {$R-}
02163 with FXSQLDA.sqlvar[Index] do
02164 begin
02165 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02166 SQLCode := (sqltype and not(1));
02167
02168 if (sqlscale < 0) then
02169 begin
02170 case SQLCode of
02171 SQL_SHORT : PSmallInt(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02172 SQL_LONG : PInteger(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02173 SQL_INT64,
02174 SQL_QUAD : PInt64(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02175 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02176 else
02177 raise EZIBConvertError.Create(SUnsupportedDataType);
02178 end;
02179 end else
02180 case SQLCode of
02181 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02182 SQL_LONG : PInteger(sqldata)^ := Value;
02183 SQL_D_FLOAT,
02184 SQL_FLOAT : PSingle(sqldata)^ := Value;
02185 SQL_BOOLEAN : PSmallint(sqldata)^ := Value;
02186 SQL_SHORT : PSmallint(sqldata)^ := Value;
02187 SQL_INT64 : PInt64(sqldata)^ := Value;
02188 SQL_TEXT : EncodeString(SQL_TEXT, Index, IntToStr(Value));
02189 SQL_VARYING : EncodeString(SQL_VARYING, Index, IntToStr(Value));
02190 else
02191 raise EZIBConvertError.Create(SUnsupportedDataType);
02192 end;
02193 if (sqlind <> nil) then sqlind^ := 0;
02194 end;
02195 {$IFOPT D+}
02196 {$R+}
02197 {$ENDIF}
02198 end;
02199
02200 {**
02201 Set up parameter null value
02202 @param Index the target parameter index
02203 @param Value the source value
02204 }
02205 procedure TZParamsSQLDA.UpdateNull(const Index: Integer; Value: boolean);
02206 begin
02207 CheckRange(Index);
02208 {$R-}
02209 with FXSQLDA.sqlvar[Index] do
02210 if (sqlind <> nil) then
02211 case Value of
02212 True : sqlind^ := -1;
02213 False : sqlind^ := 0;
02214 end;
02215 {$IFOPT D+}
02216 {$R+}
02217 {$ENDIF}
02218 end;
02219
02220 {**
02221 Set up parameter PChar value
02222 @param Index the target parameter index
02223 @param Value the source value
02224 }
02225 procedure TZParamsSQLDA.UpdatePChar(const Index: Integer; Value: PChar);
02226 var
02227 TempString: string;
02228 begin
02229 TempString := Value;
02230 UpdateString(Index, TempString);
02231 end;
02232
02233 {**
02234 Set up parameter Interbase QUAD value
02235 @param Index the target parameter index
02236 @param Value the source value
02237 }
02238 procedure TZParamsSQLDA.UpdateQuad(const Index: Word; const Value: TISC_QUAD);
02239 begin
02240 CheckRange(Index);
02241 SetFieldType(Index, sizeof(TISC_QUAD), SQL_QUAD + 1, 0);
02242 {$R-}
02243 with FXSQLDA.sqlvar[Index] do
02244 if not ((sqlind <> nil) and (sqlind^ = -1)) then
02245 begin
02246 case (sqltype and not(1)) of
02247 SQL_QUAD, SQL_DOUBLE, SQL_INT64, SQL_BLOB, SQL_ARRAY: PISC_QUAD(sqldata)^ := Value;
02248 else
02249 raise EZIBConvertError.Create(SUnsupportedDataType);
02250 end;
02251 if (sqlind <> nil) then sqlind^ := 0;
02252 end else
02253 raise EZIBConvertError.Create(SUnsupportedDataType);
02254 {$IFOPT D+}
02255 {$R+}
02256 {$ENDIF}
02257 end;
02258
02259 {**
02260 Set up parameter short value
02261 @param Index the target parameter index
02262 @param Value the source value
02263 }
02264 procedure TZParamsSQLDA.UpdateShort(const Index: Integer; Value: SmallInt);
02265 var
02266 SQLCode: SmallInt;
02267 begin
02268 CheckRange(Index);
02269 SetFieldType(Index, sizeof(Smallint), SQL_SHORT + 1, 0);
02270 {$R-}
02271 with FXSQLDA.sqlvar[Index] do
02272 begin
02273 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02274 SQLCode := (sqltype and not(1));
02275
02276 if (sqlscale < 0) then
02277 begin
02278 case SQLCode of
02279 SQL_SHORT : PSmallInt(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02280 SQL_LONG : PInteger(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02281 SQL_INT64,
02282 SQL_QUAD : PInt64(sqldata)^ := Value * IBScaleDivisor[sqlscale];
02283 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02284 else
02285 raise EZIBConvertError.Create(SUnsupportedDataType);
02286 end;
02287 end else
02288 case SQLCode of
02289 SQL_DOUBLE : PDouble(sqldata)^ := Value;
02290 SQL_LONG : PInteger(sqldata)^ := Value;
02291 SQL_D_FLOAT,
02292 SQL_FLOAT : PSingle(sqldata)^ := Value;
02293 SQL_BOOLEAN : PSmallint(sqldata)^ := Value;
02294 SQL_SHORT : PSmallint(sqldata)^ := Value;
02295 SQL_INT64 : PInt64(sqldata)^ := Value;
02296 SQL_TEXT : EncodeString(SQL_TEXT, Index, IntToStr(Value));
02297 SQL_VARYING : EncodeString(SQL_VARYING, Index, IntToStr(Value));
02298 else
02299 raise EZIBConvertError.Create(SUnsupportedDataType);
02300 end;
02301 if (sqlind <> nil) then sqlind^ := 0;
02302 end;
02303 {$IFOPT D+}
02304 {$R+}
02305 {$ENDIF}
02306 end;
02307
02308 {**
02309 Set up parameter String value
02310 @param Index the target parameter index
02311 @param Value the source value
02312 }
02313 procedure TZParamsSQLDA.UpdateString(const Index: Integer; Value: string);
02314 var
02315 SQLCode: SmallInt;
02316 Stream: TStream;
02317 begin
02318 CheckRange(Index);
02319
02320 {$R-}
02321 with FXSQLDA.sqlvar[Index] do
02322 begin
02323 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02324 SQLCode := (sqltype and not(1));
02325 case SQLCode of
02326 SQL_TEXT : EncodeString(SQL_TEXT, Index, Value);
02327 SQL_VARYING : EncodeString(SQL_VARYING, Index, Value);
02328 SQL_LONG: PInteger(sqldata)^ := StrToInt(Value);
02329 SQL_TYPE_DATE : EncodeString(SQL_DATE, Index, Value);
02330 SQL_BLOB: begin
02331 Stream := TStringStream.Create(Value);
02332 try
02333 WriteBlob(index, Stream);
02334 finally
02335 Stream.Free;
02336 end;
02337 end;
02338 else
02339 raise EZIBConvertError.Create(SErrorConvertion);
02340 end;
02341 if (sqlind <> nil) then sqlind^ := 0;
02342 end;
02343 {$IFOPT D+}
02344 {$R+}
02345 {$ENDIF}
02346 end;
02347
02348 {**
02349 Set up parameter Time value
02350 @param Index the target parameter index
02351 @param Value the source value
02352 }
02353 procedure TZParamsSQLDA.UpdateTime(const Index: Integer; Value: TDateTime);
02354 begin
02355 SetFieldType(Index, sizeof(Cardinal), SQL_TYPE_TIME + 1, 0);
02356 UpdateDateTime(Index, Value);
02357 end;
02358
02359 {**
02360 Set up parameter Timestamp value
02361 @param Index the target parameter index
02362 @param Value the source value
02363 }
02364 procedure TZParamsSQLDA.UpdateTimestamp(const Index: Integer; Value: TDateTime);
02365 begin
02366 SetFieldType(Index, sizeof(TISC_QUAD), SQL_TIMESTAMP + 1, 0);
02367 UpdateDateTime(Index, Value);
02368 end;
02369
02370 {**
02371 Write stream to blob field
02372 @param Index an index field number
02373 @param Stream the souse data stream
02374 }
02375 procedure TZParamsSQLDA.WriteBlob(const Index: Integer; Stream: TStream);
02376 var
02377 Buffer: PChar;
02378 BlobId: TISC_QUAD;
02379 BlobHandle: TISC_BLOB_HANDLE;
02380 StatusVector: TARRAY_ISC_STATUS;
02381 BlobSize, CurPos, SegLen: Integer;
02382 begin
02383 BlobHandle := nil;
02384 Stream.Seek(0, 0);
02385
02386 { create blob handle }
02387 FPlainDriver.isc_create_blob2(@StatusVector, FHandle, FTransactionHandle,
02388 @BlobHandle, @BlobId, 0, nil);
02389 CheckInterbase6Error(FPlainDriver, StatusVector);
02390
02391 Stream.Position := 0;
02392 BlobSize := Stream.Size;
02393 Buffer := AllocMem(BlobSize);
02394 Try
02395 Stream.ReadBuffer(Buffer^, BlobSize);
02396
02397 { put data to blob }
02398 CurPos := 0;
02399 SegLen := DefaultBlobSegmentSize;
02400 while (CurPos < BlobSize) do
02401 begin
02402 if (CurPos + SegLen > BlobSize) then
02403 SegLen := BlobSize - CurPos;
02404 if FPlainDriver.isc_put_segment(@StatusVector, @BlobHandle, SegLen,
02405 PChar(@Buffer[CurPos])) > 0 then
02406 CheckInterbase6Error(FPlainDriver, StatusVector);
02407 Inc(CurPos, SegLen);
02408 end;
02409
02410 { close blob handle }
02411 FPlainDriver.isc_close_blob(@StatusVector, @BlobHandle);
02412 CheckInterbase6Error(FPlainDriver, StatusVector);
02413
02414 Stream.Seek(0, 0);
02415 UpdateQuad(Index, BlobId);
02416 Finally
02417 Freemem(Buffer);
02418 End;
02419 end;
02420
02421 { TResultSQLDA }
02422
02423 {**
02424 Decode Interbase field value to pascal string
02425 @param Code the Interbase data type
02426 @param Index field index
02427 @result the field string
02428 }
02429 function TZResultSQLDA.DecodeString(const Code: Smallint;
02430 const Index: Word): String;
02431 var l : integer;
02432 begin
02433 {$R-}
02434 with FXSQLDA.sqlvar[Index] do
02435 case Code of
02436 SQL_TEXT : begin
02437 Result := BufferToStr(sqldata, sqllen);
02438
02439 l := sqllen;
02440 while (l>0) and (Result[l] = ' ') do dec(l);
02441 if l < sqllen then result := copy(result,1,l);
02442 end;
02443 SQL_VARYING : SetString(Result, PISC_VARYING(sqldata).str,
02444 PISC_VARYING(sqldata).strlen);
02445 end;
02446 {$IFOPT D+}
02447 {$R+}
02448 {$ENDIF}
02449 end;
02450
02451 {**
02452 Decode Interbase field value to pascal string
02453 @param Code the Interbase data type
02454 @param Index field index
02455 @param Str the field string
02456 }
02457 procedure TZResultSQLDA.DecodeString2(const Code: Smallint; const Index: Word;
02458 out Str: string);
02459 begin
02460 Str := DecodeString(Code,Index);
02461 end;
02462
02463 {**
02464 Constructs this object and assignes the main properties.
02465 param PlainDriver the interbase plain driver
02466 }
02467 constructor TZResultSQLDA.Create(PlainDriver: IZInterbasePlainDriver;
02468 Handle: PISC_DB_HANDLE; TransactionHandle: PISC_TR_HANDLE);
02469 begin
02470 FPlainDriver := PlainDriver;
02471 FHandle := Handle;
02472 FTransactionHandle := TransactionHandle;
02473
02474 GetMem(FXSQLDA, XSQLDA_LENGTH(0));
02475 FillChar(FXSQLDA^, XSQLDA_LENGTH(0), 0);
02476 FXSQLDA.sqln := 0;
02477 FXSQLDA.sqld := 0;
02478
02479 FXSQLDA.version := SQLDA_VERSION1;
02480 end;
02481
02482 {**
02483 Return BigDecimal field value
02484 @param Index the field index
02485 @return the field BigDecimal value
02486 }
02487 function TZResultSQLDA.GetBigDecimal(const Index: Integer): Extended;
02488 var
02489 SQLCode: SmallInt;
02490 begin
02491 CheckRange(Index);
02492 {$R-}
02493 with FXSQLDA.sqlvar[Index] do
02494 begin
02495 Result := 0;
02496 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02497 SQLCode := (sqltype and not(1));
02498
02499 if (sqlscale < 0) then
02500 begin
02501 case SQLCode of
02502 SQL_SHORT : Result := PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale];
02503 SQL_LONG : Result := PInteger(sqldata)^ / IBScaleDivisor[sqlscale];
02504 SQL_INT64,
02505 SQL_QUAD : Result := PInt64(sqldata)^ / IBScaleDivisor[sqlscale];
02506 SQL_DOUBLE : Result := PDouble(sqldata)^;
02507 else
02508 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02509 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02510 end;
02511 end else
02512 case SQLCode of
02513 SQL_DOUBLE : Result := PDouble(sqldata)^;
02514 SQL_LONG : Result := PInteger(sqldata)^;
02515 SQL_D_FLOAT,
02516 SQL_FLOAT : Result := PSingle(sqldata)^;
02517 SQL_BOOLEAN : Result := PSmallint(sqldata)^;
02518 SQL_SHORT : Result := PSmallint(sqldata)^;
02519 SQL_INT64 : Result := PInt64(sqldata)^;
02520 SQL_TEXT : Result := StrToFloat(DecodeString(SQL_TEXT, Index));
02521 SQL_VARYING : Result := StrToFloat(DecodeString(SQL_VARYING, Index));
02522 else
02523 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02524 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02525 end;
02526 end;
02527 {$IFOPT D+}
02528 {$R+}
02529 {$ENDIF}
02530 end;
02531
02532 {**
02533 Return Boolean field value
02534 @param Index the field index
02535 @return the field boolean value
02536 }
02537 function TZResultSQLDA.GetBoolean(const Index: Integer): Boolean;
02538 var
02539 SQLCode: SmallInt;
02540 begin
02541 CheckRange(Index);
02542 {$R-}
02543 with FXSQLDA.sqlvar[Index] do
02544 begin
02545 Result := False;
02546 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02547 SQLCode := (sqltype and not(1));
02548
02549 if (sqlscale < 0) then
02550 begin
02551 case SQLCode of
02552 SQL_SHORT : Result := PSmallInt(sqldata)^ div IBScaleDivisor[sqlscale] <> 0;
02553 SQL_LONG : Result := PInteger(sqldata)^ div IBScaleDivisor[sqlscale] <> 0;
02554 SQL_INT64,
02555 SQL_QUAD : Result := PInt64(sqldata)^ div IBScaleDivisor[sqlscale] <> 0;
02556 SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^) > 0;
02557 else
02558 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02559 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02560 end;
02561 end else
02562 case SQLCode of
02563 SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^) <> 0;
02564 SQL_LONG : Result := PInteger(sqldata)^ <> 0;
02565 SQL_D_FLOAT,
02566 SQL_FLOAT : Result := Trunc(PSingle(sqldata)^) <> 0;
02567 SQL_BOOLEAN : Result := PSmallint(sqldata)^ <> 0;
02568 SQL_SHORT : Result := PSmallint(sqldata)^ <> 0;
02569 SQL_INT64 : Result := PInt64(sqldata)^ <> 0;
02570 SQL_TEXT : Result := StrToInt(DecodeString(SQL_TEXT, Index)) <> 0;
02571 SQL_VARYING : Result := StrToInt(DecodeString(SQL_VARYING, Index)) <> 0;
02572 else
02573 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02574 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02575 end;
02576 end;
02577 {$IFOPT D+}
02578 {$R+}
02579 {$ENDIF}
02580 end;
02581
02582 {**
02583 Return Byte field value
02584 @param Index the field index
02585 @return the field Byte value
02586 }
02587 function TZResultSQLDA.GetByte(const Index: Integer): ShortInt;
02588 begin
02589 Result := ShortInt(GetShort(Index));
02590 end;
02591
02592 {**
02593 Return Bytes field value
02594 @param Index the field index
02595 @return the field Bytes value
02596 }
02597 function TZResultSQLDA.GetBytes(const Index: Integer): TByteDynArray;
02598 begin
02599 Result := nil;
02600 end;
02601
02602 {**
02603 Return Date field value
02604 @param Index the field index
02605 @return the field Date value
02606 }
02607 function TZResultSQLDA.GetDate(const Index: Integer): TDateTime;
02608 begin
02609 Result := Trunc(GetTimestamp(Index));
02610 end;
02611
02612 {**
02613 Return Double field value
02614 @param Index the field index
02615 @return the field Double value
02616 }
02617 function TZResultSQLDA.GetDouble(const Index: Integer): Double;
02618 var
02619 SQLCode: SmallInt;
02620 begin
02621 CheckRange(Index);
02622 {$R-}
02623 with FXSQLDA.sqlvar[Index] do
02624 begin
02625 Result := 0;
02626 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02627 SQLCode := (sqltype and not(1));
02628
02629 if (sqlscale < 0) then
02630 begin
02631 case SQLCode of
02632 SQL_SHORT : Result := PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale];
02633 SQL_LONG : Result := PInteger(sqldata)^ / IBScaleDivisor[sqlscale];
02634 SQL_INT64,
02635 SQL_QUAD : Result := PInt64(sqldata)^ / IBScaleDivisor[sqlscale];
02636 SQL_DOUBLE : Result := PDouble(sqldata)^;
02637 else
02638 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02639 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02640 end;
02641 end else
02642 case SQLCode of
02643 SQL_DOUBLE : Result := PDouble(sqldata)^;
02644 SQL_LONG : Result := PInteger(sqldata)^;
02645 SQL_D_FLOAT,
02646 SQL_FLOAT : Result := PSingle(sqldata)^;
02647 SQL_BOOLEAN : Result := PSmallint(sqldata)^;
02648 SQL_SHORT : Result := PSmallint(sqldata)^;
02649 SQL_INT64 : Result := PInt64(sqldata)^;
02650 SQL_TEXT : Result := StrToFloat(DecodeString(SQL_TEXT, Index));
02651 SQL_VARYING : Result := StrToFloat(DecodeString(SQL_VARYING, Index));
02652 else
02653 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02654 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02655 end;
02656 end;
02657 {$IFOPT D+}
02658 {$R+}
02659 {$ENDIF}
02660 end;
02661
02662 {**
02663 Return Float field value
02664 @param Index the field index
02665 @return the field Float value
02666 }
02667 function TZResultSQLDA.GetFloat(const Index: Integer): Single;
02668 var
02669 SQLCode: SmallInt;
02670 begin
02671 CheckRange(Index);
02672 {$R-}
02673 with FXSQLDA.sqlvar[Index] do
02674 begin
02675 Result := 0;
02676 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02677 SQLCode := (sqltype and not(1));
02678
02679 if (sqlscale < 0) then
02680 begin
02681 case SQLCode of
02682 SQL_SHORT : Result := PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale];
02683 SQL_LONG : Result := PInteger(sqldata)^ / IBScaleDivisor[sqlscale];
02684 SQL_INT64,
02685 SQL_QUAD : Result := PInt64(sqldata)^ / IBScaleDivisor[sqlscale];
02686 SQL_DOUBLE : Result := PDouble(sqldata)^;
02687 else
02688 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02689 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02690 end;
02691 end else
02692 case SQLCode of
02693 SQL_DOUBLE : Result := PDouble(sqldata)^;
02694 SQL_LONG : Result := PInteger(sqldata)^;
02695 SQL_D_FLOAT,
02696 SQL_FLOAT : Result := PSingle(sqldata)^;
02697 SQL_BOOLEAN : Result := PSmallint(sqldata)^;
02698 SQL_SHORT : Result := PSmallint(sqldata)^;
02699 SQL_INT64 : Result := PInt64(sqldata)^;
02700 SQL_TEXT : Result := StrToFloat(DecodeString(SQL_TEXT, Index));
02701 SQL_VARYING : Result := StrToFloat(DecodeString(SQL_VARYING, Index));
02702 else
02703 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02704 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02705 end;
02706 end;
02707 {$IFOPT D+}
02708 {$R+}
02709 {$ENDIF}
02710 end;
02711
02712 {**
02713 Return Integer field value
02714 @param Index the field index
02715 @return the field Integer value
02716 }
02717 function TZResultSQLDA.GetInt(const Index: Integer): Integer;
02718 begin
02719 Result := Integer(GetLong(Index));
02720 end;
02721
02722 {**
02723 Return Long field value
02724 @param Index the field index
02725 @return the field Long value
02726 }
02727 function TZResultSQLDA.GetLong(const Index: Integer): Int64;
02728 var
02729 SQLCode: SmallInt;
02730 begin
02731 CheckRange(Index);
02732 {$R-}
02733 with FXSQLDA.sqlvar[Index] do
02734 begin
02735 Result := 0;
02736 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02737 SQLCode := (sqltype and not(1));
02738
02739 if (sqlscale < 0) then
02740 begin
02741 case SQLCode of
02742 SQL_SHORT : Result := PSmallInt(sqldata)^ div IBScaleDivisor[sqlscale];
02743 SQL_LONG : Result := PInteger(sqldata)^ div IBScaleDivisor[sqlscale];
02744 SQL_INT64,
02745 SQL_QUAD : Result := PInt64(sqldata)^ div IBScaleDivisor[sqlscale];
02746 SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^);
02747 else
02748 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02749 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02750 end;
02751 end else
02752 case SQLCode of
02753 SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^);
02754 SQL_LONG : Result := PInteger(sqldata)^;
02755 SQL_D_FLOAT,
02756 SQL_FLOAT : Result := Trunc(PSingle(sqldata)^);
02757 SQL_BOOLEAN : Result := PSmallint(sqldata)^;
02758 SQL_SHORT : Result := PSmallint(sqldata)^;
02759 SQL_INT64 : Result := PInt64(sqldata)^;
02760 SQL_TEXT : Result := StrToInt(DecodeString(SQL_TEXT, Index));
02761 SQL_VARYING : Result := StrToInt(DecodeString(SQL_VARYING, Index));
02762 else
02763 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02764 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02765 end;
02766 end;
02767 {$IFOPT D+}
02768 {$R+}
02769 {$ENDIF}
02770 end;
02771
02772 {**
02773 Return Pchar field value
02774 @param Index the field index
02775 @return the field PChar value
02776 }
02777 function TZResultSQLDA.GetPChar(const Index: Integer): PChar;
02778 var
02779 TempStr: string;
02780 begin
02781 TempStr := GetString(Index);
02782 Result := PChar(TempStr);
02783 end;
02784
02785 {**
02786 Return Short field value
02787 @param Index the field index
02788 @return the field Short value
02789 }
02790 function TZResultSQLDA.GetShort(const Index: Integer): SmallInt;
02791 var
02792 SQLCode: SmallInt;
02793 begin
02794 CheckRange(Index);
02795 {$R-}
02796 with FXSQLDA.sqlvar[Index] do
02797 begin
02798 Result := 0;
02799 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02800 SQLCode := (sqltype and not(1));
02801
02802 if (sqlscale < 0) then
02803 begin
02804 case SQLCode of
02805 SQL_SHORT : Result := PSmallInt(sqldata)^ div IBScaleDivisor[sqlscale];
02806 SQL_LONG : Result := PInteger(sqldata)^ div IBScaleDivisor[sqlscale];
02807 SQL_INT64,
02808 SQL_QUAD : Result := PInt64(sqldata)^ div IBScaleDivisor[sqlscale];
02809 SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^);
02810 else
02811 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02812 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02813 end;
02814 end else
02815 case SQLCode of
02816 SQL_DOUBLE : Result := Trunc(PDouble(sqldata)^);
02817 SQL_LONG : Result := PInteger(sqldata)^;
02818 SQL_D_FLOAT,
02819 SQL_FLOAT : Result := Trunc(PSingle(sqldata)^);
02820 SQL_BOOLEAN : Result := PSmallint(sqldata)^;
02821 SQL_SHORT : Result := PSmallint(sqldata)^;
02822 SQL_INT64 : Result := PInt64(sqldata)^;
02823 SQL_TEXT : Result := StrToInt(DecodeString(SQL_TEXT, Index));
02824 SQL_VARYING : Result := StrToInt(DecodeString(SQL_VARYING, Index));
02825 else
02826 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02827 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02828 end;
02829 end;
02830 {$IFOPT D+}
02831 {$R+}
02832 {$ENDIF}
02833 end;
02834
02835 {**
02836 Return String field value
02837 @param Index the field index
02838 @return the field String value
02839 }
02840 function TZResultSQLDA.GetString(const Index: Integer): string;
02841 var
02842 SQLCode: SmallInt;
02843 begin
02844 CheckRange(Index);
02845 Result := '';
02846 {$R-}
02847 with FXSQLDA.sqlvar[Index] do
02848 begin
02849 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02850 SQLCode := (sqltype and not(1));
02851
02852 if (sqlscale < 0) then
02853 begin
02854 case SQLCode of
02855 SQL_SHORT : Result := FloatToStr(PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale]);
02856 SQL_LONG : Result := FloatToStr(PInteger(sqldata)^ / IBScaleDivisor[sqlscale]);
02857 SQL_INT64,
02858 SQL_QUAD : Result := FloatToStr(PInt64(sqldata)^ / IBScaleDivisor[sqlscale]);
02859 SQL_DOUBLE : Result := FloatToStr(PDouble(sqldata)^);
02860 else
02861 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02862 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02863 end;
02864 end else
02865 case SQLCode of
02866 SQL_DOUBLE : Result := FloatToStr(PDouble(sqldata)^);
02867 SQL_LONG : Result := IntToStr(PInteger(sqldata)^);
02868 SQL_D_FLOAT,
02869 SQL_FLOAT : Result := FloatToStr(PSingle(sqldata)^);
02870 SQL_BOOLEAN :
02871 if Boolean(PSmallint(sqldata)^) = True then
02872 Result := 'YES'
02873 else
02874 Result := 'NO';
02875 SQL_SHORT : Result := IntToStr(PSmallint(sqldata)^);
02876 SQL_INT64 : Result := IntToStr(PInt64(sqldata)^);
02877 SQL_TEXT : DecodeString2(SQL_TEXT, Index, Result);
02878 SQL_VARYING : DecodeString2(SQL_VARYING, Index, Result);
02879 SQL_BLOB : if VarIsEmpty(FDefaults[Index]) then
02880 begin
02881 ReadBlobFromString(Index, Result);
02882 FDefaults[Index] := Result;
02883 end
02884 else
02885 Result := FDefaults[Index];
02886
02887 else
02888 raise EZIBConvertError.Create(Format(SErrorConvertionField,
02889 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
02890 end;
02891 end;
02892 {$IFOPT D+}
02893 {$R+}
02894 {$ENDIF}
02895 end;
02896
02897 {**
02898 Return Time field value
02899 @param Index the field index
02900 @return the field Time value
02901 }
02902 function TZResultSQLDA.GetTime(const Index: Integer): TDateTime;
02903 begin
02904 Result := Frac(GetTimestamp(Index));
02905 end;
02906
02907 {**
02908 Return Timestamp field value
02909 @param Index the field index
02910 @return the field Timestamp value
02911 }
02912 function TZResultSQLDA.GetTimestamp(const Index: Integer): TDateTime;
02913 var
02914 TempDate: TCTimeStructure;
02915 begin
02916 CheckRange(Index);
02917 {$R-}
02918 with FXSQLDA.sqlvar[Index] do
02919 begin
02920 Result := 0;
02921 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
02922
02923 case (sqltype and not(1)) of
02924 SQL_TIMESTAMP : begin
02925 FPlainDriver.isc_decode_date(PISC_QUAD(sqldata), @TempDate);
02926 Result := SysUtils.EncodeDate(TempDate.tm_year + 1900,
02927 TempDate.tm_mon + 1, TempDate.tm_mday) + EncodeTime(TempDate.tm_hour,
02928 TempDate.tm_min, TempDate.tm_sec, 0);
02929 end;
02930 SQL_TYPE_DATE : begin
02931 FPlainDriver.isc_decode_sql_date(PISC_DATE(sqldata), @TempDate);
02932 Result := SysUtils.EncodeDate(Word(TempDate.tm_year + 1900),
02933 Word(TempDate.tm_mon + 1), Word(TempDate.tm_mday));
02934 end;
02935 SQL_TYPE_TIME : begin
02936 FPlainDriver.isc_decode_sql_time(PISC_TIME(sqldata), @TempDate);
02937 Result := SysUtils.EncodeTime(Word(TempDate.tm_hour), Word(TempDate.tm_min),
02938 Word(TempDate.tm_sec), 0);
02939 end;
02940 else
02941 Result := Trunc(GetDouble(Index));
02942 end;
02943 end;
02944 {$IFOPT D+}
02945 {$R+}
02946 {$ENDIF}
02947 end;
02948
02949 {**
02950 Indicate field null
02951 @param Index the field index
02952 @return true if fied value NULL overwise false
02953 }
02954 function TZResultSQLDA.IsNull(const Index: Integer): Boolean;
02955 begin
02956 CheckRange(Index);
02957 {$R-}
02958 with FXSQLDA.sqlvar[Index] do
02959 Result := (sqlind <> nil) and (sqlind^ = ISC_NULL);
02960 {$IFOPT D+}
02961 {$R+}
02962 {$ENDIF}
02963 end;
02964
02965 {**
02966 Return Interbase QUAD field value
02967 @param Index the field index
02968 @return the field Interbase QUAD value
02969 }
02970 function TZResultSQLDA.GetQuad(const Index: Integer): TISC_QUAD;
02971 begin
02972 CheckRange(Index);
02973 {$R-}
02974 with FXSQLDA.sqlvar[Index] do
02975 if not ((sqlind <> nil) and (sqlind^ = -1)) then
02976 case (sqltype and not(1)) of
02977 SQL_QUAD, SQL_DOUBLE, SQL_INT64, SQL_BLOB, SQL_ARRAY: result := PISC_QUAD(sqldata)^;
02978 else
02979 raise EZIBConvertError.Create(SUnsupportedDataType + ' ' + inttostr((sqltype and not(1))));
02980 end
02981 else
02982 raise EZIBConvertError.Create('Invalid State.');
02983 {$IFOPT D+}
02984 {$R+}
02985 {$ENDIF}
02986 end;
02987
02988 {**
02989 Return Variant field value
02990 @param Index the field index
02991 @return the field Variant value
02992 }
02993 function TZResultSQLDA.GetValue(const Index: Word): Variant;
02994 var
02995 SQLCode: SmallInt;
02996 begin
02997 CheckRange(Index);
02998 with FXSQLDA.sqlvar[Index] do
02999 begin
03000 VarClear(Result);
03001 if (sqlind <> nil) and (sqlind^ = -1) then Exit;
03002 SQLCode := (sqltype and not(1));
03003
03004 if (sqlscale < 0) then
03005 begin
03006 case SQLCode of
03007 SQL_SHORT : Result := PSmallInt(sqldata)^ / IBScaleDivisor[sqlscale];
03008 SQL_LONG : Result := PInteger(sqldata)^ / IBScaleDivisor[sqlscale];
03009 SQL_INT64,
03010 SQL_QUAD : Result := PInt64(sqldata)^ / IBScaleDivisor[sqlscale];
03011 SQL_DOUBLE : Result := PDouble(sqldata)^;
03012 else
03013 raise EZIBConvertError.Create(Format(SErrorConvertionField,
03014 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
03015 end;
03016 end else
03017 case SQLCode of
03018 SQL_DOUBLE : Result := PDouble(sqldata)^;
03019 SQL_TIMESTAMP : Result := GetTimestamp(Index);
03020 SQL_TYPE_DATE : Result := GetDate(Index);
03021 SQL_TYPE_TIME : Result := GetTime(Index);
03022 SQL_LONG : Result := PInteger(sqldata)^;
03023 SQL_D_FLOAT,
03024 SQL_FLOAT : Result := PSingle(sqldata)^;
03025 SQL_BOOLEAN: begin
03026 if FPlainDriver.GetProtocol <> 'interbase-7' then
03027 raise EZIBConvertError.Create(SUnsupportedDataType);
03028 Result := IntToStr(PSmallint(sqldata)^);
03029 end;
03030 SQL_SHORT : Result := PSmallint(sqldata)^;
03031 {$IFDEF COMPILER6_UP}
03032 SQL_INT64 : Result := PInt64(sqldata)^;
03033 {$ELSE}
03034 SQL_INT64 : Result := Integer(PInt64(sqldata)^);
03035 {$ENDIF}
03036 SQL_TEXT : Result := DecodeString(SQL_TEXT, Index);
03037 SQL_VARYING : Result := DecodeString(SQL_VARYING, Index);
03038 SQL_BLOB : if VarIsEmpty(FDefaults[Index]) then
03039 begin
03040 ReadBlobFromVariant(Index, FDefaults[Index]);
03041 Result := FDefaults[Index];
03042 end
03043 else
03044 Result := Double(FDefaults[Index]);
03045 else
03046 raise EZIBConvertError.Create(Format(SErrorConvertionField,
03047 [GetFieldAliasName(Index), GetNameSqlType(SQLCode)]));
03048 end;
03049 end;
03050 end;
03051
03052 destructor TZResultSQLDA.Destroy;
03053 begin
03054 FreeParamtersValues;
03055 FreeMem(FXSQLDA);
03056 inherited Destroy;
03057 end;
03058
03059 {**
03060 Read blob data to string
03061 @param Index an filed index
03062 @param Str destination string
03063 }
03064 procedure TZResultSQLDA.ReadBlobFromString(const Index: Word; var Str: string);
03065 var
03066 Size: LongInt;
03067 Buffer: Pointer;
03068 begin
03069 ReadBlobBufer(FPlainDriver, FHandle, FTransactionHandle, GetQuad(Index),
03070 Size, Buffer);
03071 try
03072 SetLength(Str, Size);
03073 SetString(Str, PChar(Buffer), Size);
03074 finally
03075 FreeMem(Buffer, Size);
03076 end;
03077 end;
03078
03079 {**
03080 Read blob data to stream
03081 @param Index an filed index
03082 @param Stream destination stream object
03083 }
03084 procedure TZResultSQLDA.ReadBlobFromStream(const Index: Word; Stream: TStream);
03085 var
03086 Size: LongInt;
03087 Buffer: Pointer;
03088 begin
03089 ReadBlobBufer(FPlainDriver, FHandle, FTransactionHandle, GetQuad(Index),
03090 Size, Buffer);
03091 try
03092 Stream.Seek(0, 0);
03093 Stream.Write(Buffer^, Size);
03094 Stream.Seek(0, 0);
03095 finally
03096 FreeMem(Buffer, Size);
03097 end;
03098 end;
03099
03100 {**
03101 Read blob data to variant value
03102 @param Index an filed index
03103 @param Value destination variant value
03104 }
03105 procedure TZResultSQLDA.ReadBlobFromVariant(const Index: Word;
03106 var Value: Variant);
03107 var
03108 Size: LongInt;
03109 Buffer: Pointer;
03110 PData: Pointer;
03111 begin
03112 ReadBlobBufer(FPlainDriver, FHandle, FTransactionHandle, GetQuad(Index),
03113 Size, Buffer);
03114 Value := VarArrayCreate([0, Size-1], varByte);
03115 PData := VarArrayLock(Value);
03116 try
03117 move(Buffer^, PData^, Size);
03118 finally
03119 VarArrayUnlock(Value);
03120 FreeMem(Buffer, Size);
03121 end;
03122 end;
03123
03124 procedure TZResultSQLDA.AllocateSQLDA;
03125 begin
03126 inherited AllocateSQLDA;
03127 SetLength(FDefaults, GetFieldCount);
03128 end;
03129
03130
03131 end.