00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { ASA Database Connectivity Classes }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { and Sergey Merkuriev }
00008 { }
00009 {*********************************************************}
00010
00011 {@********************************************************}
00012 { Copyright (c) 1999-2006 Zeos Development Group }
00013 { }
00014 { License Agreement: }
00015 { }
00016 { This library is distributed in the hope that it will be }
00017 { useful, but WITHOUT ANY WARRANTY; without even the }
00018 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00019 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00020 { Public License for more details. }
00021 { }
00022 { The source code of the ZEOS Libraries and packages are }
00023 { distributed under the Library GNU General Public }
00024 { License (see the file COPYING / COPYING.ZEOS) }
00025 { with the following modification: }
00026 { As a special exception, the copyright holders of this }
00027 { library give you permission to link this library with }
00028 { independent modules to produce an executable, }
00029 { regardless of the license terms of these independent }
00030 { modules, and to copy and distribute the resulting }
00031 { executable under terms of your choice, provided that }
00032 { you also meet, for each linked independent module, }
00033 { the terms and conditions of the license of that module. }
00034 { An independent module is a module which is not derived }
00035 { from or based on this library. If you modify this }
00036 { library, you may extend this exception to your version }
00037 { of the library, but you are not obligated to do so. }
00038 { If you do not wish to do so, delete this exception }
00039 { statement from your version. }
00040 { }
00041 { }
00042 { The project web site is located on: }
00043 { http:
00044 { http:
00045 { svn:
00046 { }
00047 { http:
00048 { http:
00049 { }
00050 { }
00051 { }
00052 { Zeos Development Group. }
00053 {********************************************************@}
00054
00055 unit ZDbcASAUtils;
00056
00057 interface
00058
00059 {$I ZDbc.inc}
00060
00061 uses
00062 Classes, SysUtils, ZSysUtils, ZDbcIntfs, ZPlainASADriver, ZDbcLogging,
00063 ZCompatibility, ZDbcASA, ZDbcStatement, ZVariant;
00064
00065 const
00066 StdVars = 20;
00067 MinBLOBSize = 256;
00068 BlockSize = 20;
00069
00070 type
00071 { Interbase Error Class}
00072 EZASAConvertError = class(Exception);
00073
00074 TZASADECLTYPE = record
00075 sqlType: SmallInt;
00076 sqlLen : Word;
00077 end;
00078
00079 { Base interface for sqlda }
00080 IZASASQLDA = interface
00081 ['{7606E8EB-9FC8-4F76-8D91-E23AB96409E1}']
00082 procedure AllocateSQLDA( NumVars: Word);
00083 procedure InitFields;
00084 procedure FreeSQLDA;
00085
00086 function GetData: PASASQLDA;
00087 function IsBlob(const Index: Word): boolean;
00088 function IsNullable(const Index: Word): boolean;
00089
00090 function GetFieldCount: Integer;
00091 function GetFieldName(const Index: Word): string;
00092 function GetFieldIndex(const Name: String): Word;
00093 function GetFieldScale(const Index: Word): integer;
00094 function GetFieldSqlType(const Index: Word): TZSQLType;
00095 function GetFieldLength(const Index: Word): Word;
00096
00097 procedure UpdateNull(const Index: Integer; Value: boolean);
00098 procedure UpdateBoolean(const Index: Integer; Value: boolean);
00099 procedure UpdateByte(const Index: Integer; Value: ShortInt);
00100 procedure UpdateShort(const Index: Integer; Value: SmallInt);
00101 procedure UpdateInt(const Index: Integer; Value: Integer);
00102 procedure UpdateLong(const Index: Integer; Value: Int64);
00103 procedure UpdateFloat(const Index: Integer; Value: Single);
00104 procedure UpdateDouble(const Index: Integer; Value: Double);
00105 procedure UpdateBigDecimal(const Index: Integer; Value: Extended);
00106 procedure UpdatePChar(const Index: Integer; Value: PChar);
00107 procedure UpdateString(const Index: Integer; Value: string);
00108 procedure UpdateBytes(const Index: Integer; Value: TByteDynArray);
00109 procedure UpdateDate(const Index: Integer; Value: TDateTime);
00110 procedure UpdateTime(const Index: Integer; Value: TDateTime);
00111 procedure UpdateTimestamp(const Index: Integer; Value: TDateTime);
00112 procedure UpdateValue(const Index: Word; Value: Variant);
00113 procedure WriteBlob(const Index: Integer; Stream: TStream);
00114
00115 function IsNull(const Index: Integer): Boolean;
00116 function IsAssigned(const Index: Integer): Boolean;
00117 function GetBoolean(const Index: Integer): Boolean;
00118 function GetByte(const Index: Integer): ShortInt;
00119 function GetShort(const Index: Integer): SmallInt;
00120 function GetInt(const Index: Integer): Integer;
00121 function GetLong(const Index: Integer): Int64;
00122 function GetFloat(const Index: Integer): Single;
00123 function GetDouble(const Index: Integer): Double;
00124 function GetBigDecimal(const Index: Integer): Extended;
00125 function GetPChar(const Index: Integer): PChar;
00126 function GetString(const Index: Integer): string;
00127 function GetBytes(const Index: Integer): TByteDynArray;
00128 function GetDate(const Index: Integer): TDateTime;
00129 function GetTime(const Index: Integer): TDateTime;
00130 function GetTimestamp(const Index: Integer): TDateTime;
00131 function GetValue(const Index: Word): Variant;
00132
00133 procedure ReadBlobToMem(const Index: Word; var Buffer: Pointer; var Length: LongWord);
00134 procedure ReadBlobToStream(const Index: Word; Stream: TStream);
00135 procedure ReadBlobToString(const Index: Word; var str: string);
00136 procedure ReadBlobToVariant(const Index: Word; var Value: Variant);
00137 end;
00138
00139 { Base class contain core functions to work with sqlda structure
00140 Can allocate memory for sqlda structure get basic information }
00141 TZASASQLDA = class (TInterfacedObject, IZASASQLDA)
00142 private
00143 FSQLDA: PASASQLDA;
00144 FPlainDriver: IZASAPlainDriver;
00145 FHandle: PZASASQLCA;
00146 FCursorName: String;
00147 procedure CreateException( Msg: string);
00148 procedure CheckIndex(const Index: Word);
00149 procedure CheckRange(const Index: Word);
00150 procedure SetFieldType(const Index: Word; ASAType: Smallint; Len: LongWord;
00151 SetDeclType: Boolean = true);
00152 protected
00153 FDeclType: array of TZASADECLTYPE;
00154 procedure ReadBlob(const Index: Word; Buffer: Pointer; Length: LongWord);
00155 public
00156 constructor Create(PlainDriver: IZASAPlainDriver; Handle: PZASASQLCA;
00157 CursorName: String; NumVars: Word = StdVars);
00158 destructor Destroy; override;
00159
00160 procedure AllocateSQLDA( NumVars: Word);
00161 procedure InitFields;
00162 procedure FreeSQLDA;
00163
00164 function GetData: PASASQLDA;
00165 function IsBlob(const Index: Word): boolean;
00166 function IsNullable(const Index: Word): boolean;
00167
00168 function GetFieldCount: Integer;
00169 function GetFieldName(const Index: Word): string;
00170 function GetFieldIndex(const Name: String): Word;
00171 function GetFieldScale(const Index: Word): Integer;
00172 function GetFieldSqlType(const Index: Word): TZSQLType;
00173 function GetFieldLength(const Index: Word): Word;
00174
00175 procedure UpdateNull(const Index: Integer; Value: boolean);
00176 procedure UpdateBoolean(const Index: Integer; Value: boolean);
00177 procedure UpdateByte(const Index: Integer; Value: ShortInt);
00178 procedure UpdateShort(const Index: Integer; Value: SmallInt);
00179 procedure UpdateInt(const Index: Integer; Value: Integer);
00180 procedure UpdateLong(const Index: Integer; Value: Int64);
00181 procedure UpdateFloat(const Index: Integer; Value: Single);
00182 procedure UpdateDouble(const Index: Integer; Value: Double);
00183 procedure UpdateBigDecimal(const Index: Integer; Value: Extended);
00184 procedure UpdatePChar(const Index: Integer; Value: PChar);
00185 procedure UpdateString(const Index: Integer; Value: string);
00186 procedure UpdateBytes(const Index: Integer; Value: TByteDynArray);
00187 procedure UpdateDate(const Index: Integer; Value: TDateTime);
00188 procedure UpdateTime(const Index: Integer; Value: TDateTime);
00189 procedure UpdateDateTime(const Index: Integer; Value: TDateTime);
00190 procedure UpdateTimestamp(const Index: Integer; Value: TDateTime);
00191 procedure UpdateValue(const Index: Word; Value: Variant);
00192 procedure WriteBlob(const Index: Integer; Stream: TStream);
00193
00194 function IsNull(const Index: Integer): Boolean;
00195 function IsAssigned(const Index: Integer): Boolean;
00196 function GetBoolean(const Index: Integer): Boolean;
00197 function GetByte(const Index: Integer): ShortInt;
00198 function GetShort(const Index: Integer): SmallInt;
00199 function GetInt(const Index: Integer): Integer;
00200 function GetLong(const Index: Integer): Int64;
00201 function GetFloat(const Index: Integer): Single;
00202 function GetDouble(const Index: Integer): Double;
00203 function GetBigDecimal(const Index: Integer): Extended;
00204 function GetPChar(const Index: Integer): PChar;
00205 function GetString(const Index: Integer): string;
00206 function GetBytes(const Index: Integer): TByteDynArray;
00207 function GetDate(const Index: Integer): TDateTime;
00208 function GetTime(const Index: Integer): TDateTime;
00209 function GetTimestamp(const Index: Integer): TDateTime;
00210 function GetValue(const Index: Word): Variant;
00211
00212 procedure ReadBlobToMem(const Index: Word; var Buffer: Pointer; var Length: LongWord);
00213 procedure ReadBlobToStream(const Index: Word; Stream: TStream);
00214 procedure ReadBlobToString(const Index: Word; var str: string);
00215 procedure ReadBlobToVariant(const Index: Word; var Value: Variant);
00216 end;
00217
00218 {**
00219 Converts a ASA native type into ZDBC SQL types.
00220 @param FieldHandle a handler to field description structure.
00221 @return a SQL undepended type.
00222 }
00223 function ConvertASATypeToSQLType( SQLType: SmallInt): TZSQLType;
00224
00225 {**
00226 Converts a ASA native type into String.
00227 @param SQLType Field of TASASQLVar structure.
00228 @return type description.
00229 }
00230 function ConvertASATypeToString( SQLType: SmallInt): String;
00231
00232 function ConvertASAJDBCToSqlType( FieldType: SmallInt): TZSQLType;
00233 {
00234 procedure TSQLTimeStampToASADateTime( DT: TSQLTimeStamp; const ASADT: PZASASQLDateTime);
00235 function ASADateTimeToSQLTimeStamp( ASADT: PZASASQLDateTime): TSQLTimeStamp;
00236 }
00237 {**
00238 Checks for possible sql errors.
00239 @param PlainDriver a MySQL plain driver.
00240 @param Handle a MySQL connection handle.
00241 @param LogCategory a logging category.
00242 @param LogMessage a logging message.
00243 }
00244 procedure CheckASAError(PlainDriver: IZASAPlainDriver;
00245 Handle: PZASASQLCA; LogCategory: TZLoggingCategory; LogMessage: string = '');
00246
00247 function GetCachedResultSet(SQL: string;
00248 Statement: IZStatement; NativeResultSet: IZResultSet): IZResultSet;
00249
00250 procedure DescribeCursor( FASAConnection: IZASAConnection; FSQLData: IZASASQLDA;
00251 Cursor, SQL: String);
00252
00253 procedure Prepare( FASAConnection: IZASAConnection; FSQLData, FParamsSQLData: IZASASQLDA;
00254 const SQL: String; StmtNum: PSmallInt; var FPrepared, FMoreResults: Boolean);
00255
00256 procedure PrepareParameters( PlainDriver: IZASAPlainDriver;
00257 InParamValues: TZVariantDynArray; InParamTypes: TZSQLTypeArray;
00258 InParamCount: Integer; ParamSqlData: IZASASQLDA);
00259
00260 function RandomString( Len: integer): string;
00261
00262 implementation
00263
00264 uses {$IFDEF FPC}Variants,{$ELSE}{$IFNDEF VER130BELOW}Variants,{$ENDIF}{$ENDIF} ZMessages, ZDbcCachedResultSet, Math;
00265
00266 { TZASASQLDA }
00267
00268 procedure TZASASQLDA.CreateException( Msg: string);
00269 begin
00270 DriverManager.LogError( lcOther, FPlainDriver.GetProtocol, '', -1, Msg);
00271 raise EZSQLException.Create( Format( SSQLError1, [ Msg]));
00272 end;
00273
00274 {**
00275 Check range count fields. If index out of range raised exception.
00276 @param Index the index field
00277 }
00278 procedure TZASASQLDA.CheckIndex(const Index: Word);
00279 begin
00280 Assert( Assigned( FSQLDA), 'SQLDA not initialized.');
00281 Assert( Index < FSQLDA.sqld, 'Out of Range.');
00282 end;
00283
00284 procedure TZASASQLDA.CheckRange(const Index: Word);
00285 begin
00286 CheckIndex( Index);
00287 Assert( Assigned( FSQLDA.sqlVar[ Index].sqlData),
00288 'No memory for variable in SQLDA.');
00289 end;
00290
00291 procedure TZASASQLDA.SetFieldType(const Index: Word; ASAType: Smallint;
00292 Len: LongWord; SetDeclType: Boolean = true);
00293 begin
00294 CheckIndex(Index);
00295 with FSQLDA.sqlvar[Index] do
00296 begin
00297 if ( ASAType and $FFFE = DT_LONGBINARY) or
00298 ( ASAType and $FFFE = DT_LONGVARCHAR) then
00299 begin
00300 if Assigned( sqlData) then
00301 ReallocMem( sqlData, SizeOf( TZASABlobStruct) + Len)
00302 else
00303 GetMem( sqlData, SizeOf( TZASABlobStruct) + Len);
00304 PZASABlobStruct( sqlData).array_len := Len;
00305 PZASABlobStruct( sqlData).stored_len := 0;
00306 PZASABlobStruct( sqlData).untrunc_len := 0;
00307 PZASABlobStruct( sqlData).arr[0] := #0;
00308 Inc( Len, SizeOf( TZASABlobStruct));
00309 end else begin
00310 if ( ASAType and $FFFE = DT_BINARY) or
00311 ( ASAType and $FFFE = DT_VARCHAR) then
00312 Inc( Len, SizeOf( TZASASQLSTRING));
00313 if Assigned( sqlData) then
00314 ReallocMem( sqlData, Len)
00315 else
00316 GetMem( sqlData, Len);
00317 if ( ASAType and $FFFE = DT_BINARY) or
00318 ( ASAType and $FFFE = DT_VARCHAR) then
00319 PZASASQLSTRING( sqlData).length := 0;
00320 end;
00321 sqlType := ASAType;
00322 sqllen := Len;
00323 if SetDeclType then
00324 begin
00325 FDeclType[Index].sqlType := sqlType;
00326 FDeclType[Index].sqlLen := sqlLen;
00327 end;
00328 end;
00329 end;
00330
00331 constructor TZASASQLDA.Create(PlainDriver: IZASAPlainDriver; Handle: PZASASQLCA;
00332 CursorName: String; NumVars: Word = StdVars);
00333 begin
00334 FPlainDriver := PlainDriver;
00335 FHandle := Handle;
00336 FCursorName := CursorName;
00337 AllocateSQLDA( NumVars);
00338 inherited Create;
00339 end;
00340
00341 destructor TZASASQLDA.Destroy;
00342 begin
00343 FreeSQLDA;
00344 inherited;
00345 end;
00346
00347 {**
00348 Reallocate SQLDA to fields count length
00349 @param Value the count fields
00350 }
00351 procedure TZASASQLDA.AllocateSQLDA( NumVars: Word);
00352 begin
00353 FreeSQLDA;
00354 FSQLDA := FPlainDriver.db_alloc_sqlda( NumVars);
00355 if not Assigned( FSQLDA) then
00356 CreateException( 'Not enough memory for SQLDA');
00357 SetLength( FDeclType, FSQLDA.sqln);
00358 end;
00359
00360 {**
00361 Allocate memory for SQLVar in SQLDA structure for every
00362 fields by it length.
00363 }
00364 procedure TZASASQLDA.InitFields;
00365 var
00366 i: Integer;
00367 begin
00368 if Assigned( FSQLDA) then
00369 begin
00370 for i := 0 to FSQLDA.sqld-1 do
00371 begin
00372 FDeclType[i].sqlType := FSQLDA.sqlVar[i].sqlType;
00373 FDeclType[i].sqlLen := FSQLDA.sqlVar[i].sqlLen;
00374 case FSQLDA.sqlVar[i].sqlType and $FFFE of
00375 DT_DATE,
00376 DT_TIME,
00377 DT_TIMESTAMP : begin
00378 FSQLDA.sqlVar[i].sqlType := DT_TIMESTAMP_STRUCT +
00379 ( FSQLDA.sqlVar[i].sqlType and $0001);
00380 FSQLDA.sqlVar[i].sqlLen := SizeOf( TZASASQLDateTime);
00381 end;
00382 DT_DECIMAL : begin
00383 FSQLDA.sqlVar[i].sqlType := DT_DOUBLE +
00384 ( FSQLDA.sqlVar[i].sqlType and $0001);
00385 FSQLDA.sqlVar[i].sqlLen := SizeOf( Double);
00386 end;
00387 DT_STRING,
00388 DT_FIXCHAR,
00389 DT_VARCHAR,
00390 DT_LONGVARCHAR: if FSQLDA.sqlVar[i].sqlLen < MinBLOBSize then
00391 FSQLDA.sqlVar[i].sqlType := DT_VARCHAR +
00392 ( FSQLDA.sqlVar[i].sqlType and $0001)
00393 else begin
00394 FSQLDA.sqlVar[i].sqlType := DT_LONGVARCHAR +
00395 ( FSQLDA.sqlVar[i].sqlType and $0001);
00396 FSQLDA.sqlVar[i].sqlLen := 0;
00397 end;
00398 DT_BINARY,
00399 DT_LONGBINARY: if FSQLDA.sqlVar[i].sqlLen < MinBLOBSize then
00400 FSQLDA.sqlVar[i].sqlType := DT_BINARY +
00401 ( FSQLDA.sqlVar[i].sqlType and $0001)
00402 else begin
00403 FSQLDA.sqlVar[i].sqlType := DT_LONGBINARY +
00404 ( FSQLDA.sqlVar[i].sqlType and $0001);
00405 FSQLDA.sqlVar[i].sqlLen := 0;
00406 end;
00407 end;
00408 SetFieldType( i, FSQLDA.sqlVar[i].sqlType, FSQLDA.sqlVar[i].sqlLen, False);
00409 end;
00410 end;
00411 end;
00412
00413 {**
00414 Clear allocated data for SQLDA parameters
00415 }
00416 procedure TZASASQLDA.FreeSQLDA;
00417 var
00418 i: integer;
00419 begin
00420 if Assigned( FSQLDA) then
00421 begin
00422 for i := 0 to FSQLDA.sqln-1 do
00423 begin
00424 if Assigned( FSQLDA.sqlVar[i].sqlData) then
00425 FreeMem( FSQLDA.sqlVar[i].sqlData);
00426 end;
00427 FPlainDriver.db_free_sqlda( FSQLDA);
00428 FSQLDA := nil;
00429 end;
00430 FDeclType := nil;
00431 end;
00432
00433 {**
00434 Return pointer to SQLDA structure
00435 }
00436 function TZASASQLDA.GetData: PASASQLDA;
00437 begin
00438 Result := FSQLDA;
00439 end;
00440
00441 {**
00442 Indicate blob field
00443 @param Index the index fields
00444 @return true if blob field overwise false
00445 }
00446 function TZASASQLDA.IsBlob(const Index: Word): boolean;
00447 begin
00448 Result := GetFieldSqlType( Index) in
00449 [ stAsciiStream, stUnicodeStream, stBinaryStream];
00450 end;
00451
00452 {**
00453 Indicate nullable field
00454 @param Index the index fields
00455 @return true if field nullable overwise false
00456 }
00457 function TZASASQLDA.IsNullable(const Index: Word): boolean;
00458 begin
00459 CheckIndex(Index);
00460 Result := FSQLDA.sqlvar[Index].sqlType and 1 = 1
00461 end;
00462
00463 {**
00464 Get fields count not allocated.
00465 @return fields count
00466 }
00467 function TZASASQLDA.GetFieldCount: Integer;
00468 begin
00469 if Assigned( FSQLDA) then
00470 Result := FSQLDA.sqld
00471 else
00472 Result := 0;
00473 end;
00474
00475 {**
00476 Return Name for field
00477 @param Index the index fields
00478 @return the name
00479 }
00480 function TZASASQLDA.GetFieldName(const Index: Word): string;
00481 begin
00482 CheckIndex(Index);
00483 SetString( Result, FSQLDA.sqlvar[Index].sqlname.data,
00484 FSQLDA.sqlvar[Index].sqlname.length-1);
00485 end;
00486
00487 {**
00488 Return field index by it name
00489 @param Index the index fields
00490 @return the index field
00491 }
00492 function TZASASQLDA.GetFieldIndex(const Name: String): Word;
00493 begin
00494 for Result := 0 to FSQLDA.sqld - 1 do
00495 if FSQLDA.sqlvar[Result].sqlname.length = Length(name) then
00496 if StrLIComp( @FSQLDA.sqlvar[ Result].sqlname.data, PChar(Name),
00497 Length(name)) = 0 then Exit;
00498 CreateException( Format( SFieldNotFound1, [name]));
00499 Result := 0;
00500 end;
00501
00502 {**
00503 Return field length
00504 @param Index the index fields
00505 @return the field lenth
00506 }
00507 function TZASASQLDA.GetFieldLength(const Index: Word): Word;
00508 begin
00509 CheckIndex( Index);
00510 if FSQLDA.sqlvar[Index].sqlType and $FFFE <> DT_DECIMAL then
00511 Result := FSQLDA.sqlvar[Index].sqlLen
00512 else
00513 Result := (FSQLDA.sqlvar[Index].sqlLen and $FF) div 2 + 1;
00514 end;
00515
00516 {**
00517 Return field scale
00518 @param Index the index fields
00519 @return the field scale
00520 }
00521 function TZASASQLDA.GetFieldScale(const Index: Word): integer;
00522 begin
00523 CheckIndex(Index);
00524 if FSQLDA.sqlvar[Index].sqlType and $FFFE <> DT_DECIMAL then
00525 Result := 0
00526 else
00527 Result := FSQLDA.sqlvar[Index].sqlLen div 256;
00528 end;
00529
00530 {**
00531 Convert ASA sql type to SQLType
00532 @param Index the index fields
00533 @return the SQLType
00534 }
00535 function TZASASQLDA.GetFieldSqlType(const Index: Word): TZSQLType;
00536 begin
00537 CheckIndex(Index);
00538 if FSQLDA.sqlvar[Index].sqlType and $FFFE <> DT_TIMESTAMP_STRUCT then
00539 Result := ConvertASATypeToSQLType( FSQLDA.sqlvar[Index].sqlType)
00540 else
00541 Result := ConvertASATypeToSQLType( FDeclType[Index].sqlType)
00542 end;
00543
00544 {**
00545 Set up parameter null value
00546 @param Index the target parameter index
00547 @param Value the source value
00548 }
00549 procedure TZASASQLDA.UpdateNull(const Index: Integer; Value: Boolean);
00550 begin
00551 CheckIndex( Index);
00552 with FSQLDA.sqlvar[ Index] do
00553 begin
00554 if not Assigned( sqlData) then
00555 SetFieldType( Index, DT_TINYINT or 1, SizeOf( Byte));
00556 if Value then
00557 sqlind^ := -1
00558 else
00559 sqlind^ := 0;
00560 end;
00561 end;
00562
00563 {**
00564 Set up parameter Boolean value
00565 @param Index the target parameter index
00566 @param Value the source value
00567 }
00568 procedure TZASASQLDA.UpdateBoolean(const Index: Integer; Value: boolean);
00569 begin
00570 CheckIndex( Index);
00571 SetFieldType( Index, DT_BIT or 1, SizeOf( Byte));
00572 with FSQLDA.sqlvar[Index] do
00573 begin
00574 case sqlType and $FFFE of
00575 DT_SMALLINT,
00576 DT_UNSSMALLINT : PSmallint(sqldata)^ := ord(Value);
00577 DT_INT,
00578 DT_UNSINT : PInteger(sqldata)^ := ord(Value);
00579 DT_FLOAT : PSingle(sqldata)^ := ord(Value);
00580 DT_DOUBLE : PDouble(sqldata)^ := ord(Value);
00581 DT_VARCHAR : begin
00582 PZASASQLSTRING( sqlData).length := 1;
00583 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00584 IntToStr( ord( Value)), sqllen-3);
00585 end;
00586 DT_TINYINT,
00587 DT_BIT : PByte(sqldata)^ := ord(Value);
00588 DT_BIGINT,
00589 DT_UNSBIGINT : PInt64(sqldata)^ := ord(Value);
00590 else
00591 CreateException( SUnsupportedParameterType);
00592 end;
00593 if (sqlind <> nil) then sqlind^ := 0;
00594 end;
00595 end;
00596
00597 {**
00598 Set up parameter Byte value
00599 @param Index the target parameter index
00600 @param Value the source value
00601 }
00602 procedure TZASASQLDA.UpdateByte(const Index: Integer; Value: ShortInt);
00603 begin
00604 CheckIndex( Index);
00605 SetFieldType( Index, DT_TINYINT or 1, SizeOf( Byte));
00606 with FSQLDA.sqlvar[Index] do
00607 begin
00608 case sqlType and $FFFE of
00609 DT_SMALLINT,
00610 DT_UNSSMALLINT : PSmallint(sqldata)^ := Value;
00611 DT_INT,
00612 DT_UNSINT : PInteger(sqldata)^ := Value;
00613 DT_FLOAT : PSingle(sqldata)^ := Value;
00614 DT_DOUBLE : PDouble(sqldata)^ := Value;
00615 DT_VARCHAR : begin
00616 PZASASQLSTRING( sqlData).length :=
00617 Length( IntToStr( Value));
00618 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00619 IntToStr( Value), sqllen-3);
00620 end;
00621 DT_TINYINT,
00622 DT_BIT : PByte(sqldata)^ := Value;
00623 DT_BIGINT,
00624 DT_UNSBIGINT : PInt64(sqldata)^ := Value;
00625 else
00626 CreateException( SUnsupportedParameterType);
00627 end;
00628 if (sqlind <> nil) then sqlind^ := 0;
00629 end;
00630 end;
00631
00632 {**
00633 Set up parameter short value
00634 @param Index the target parameter index
00635 @param Value the source value
00636 }
00637 procedure TZASASQLDA.UpdateShort(const Index: Integer; Value: SmallInt);
00638 begin
00639 CheckIndex( Index);
00640 SetFieldType( Index, DT_SMALLINT or 1, SizeOf( SmallInt));
00641 with FSQLDA.sqlvar[Index] do
00642 begin
00643 case sqlType and $FFFE of
00644 DT_SMALLINT,
00645 DT_UNSSMALLINT : PSmallInt(sqldata)^ := Value;
00646 DT_INT,
00647 DT_UNSINT : PInteger(sqldata)^ := Value;
00648 DT_FLOAT : PSingle(sqldata)^ := Value;
00649 DT_DOUBLE : PDouble(sqldata)^ := Value;
00650 DT_VARCHAR : begin
00651 PZASASQLSTRING( sqlData).length :=
00652 Length( IntToStr( Value));
00653 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00654 IntToStr( Value), sqllen-3);
00655 end;
00656 DT_TINYINT,
00657 DT_BIT : PByte(sqldata)^ := Value;
00658 DT_BIGINT,
00659 DT_UNSBIGINT : PInt64(sqldata)^ := Value;
00660 else
00661 CreateException( SUnsupportedParameterType);
00662 end;
00663 if (sqlind <> nil) then sqlind^ := 0;
00664 end;
00665 end;
00666
00667 {**
00668 Set up parameter integer value
00669 @param Index the target parameter index
00670 @param Value the source value
00671 }
00672 procedure TZASASQLDA.UpdateInt(const Index: Integer; Value: Integer);
00673 begin
00674 CheckIndex( Index);
00675 SetFieldType( Index, DT_INT or 1, SizeOf( Integer));
00676 with FSQLDA.sqlvar[Index] do
00677 begin
00678 case sqlType and $FFFE of
00679 DT_SMALLINT,
00680 DT_UNSSMALLINT : PSmallint(sqldata)^ := Value;
00681 DT_INT,
00682 DT_UNSINT : PInteger(sqldata)^ := Value;
00683 DT_FLOAT : PSingle(sqldata)^ := Value;
00684 DT_DOUBLE : PDouble(sqldata)^ := Value;
00685 DT_VARCHAR : begin
00686 PZASASQLSTRING( sqlData).length :=
00687 Length( IntToStr( Value));
00688 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00689 IntToStr( Value), sqllen-3);
00690 end;
00691 DT_TINYINT,
00692 DT_BIT : PByte(sqldata)^ := Value;
00693 DT_BIGINT,
00694 DT_UNSBIGINT : PInt64(sqldata)^ := Value;
00695 else
00696 CreateException( SUnsupportedParameterType);
00697 end;
00698 if (sqlind <> nil) then sqlind^ := 0;
00699 end;
00700 end;
00701
00702 {**
00703 Set up parameter Long value
00704 @param Index the target parameter index
00705 @param Value the source value
00706 }
00707 procedure TZASASQLDA.UpdateLong(const Index: integer; Value: Int64);
00708 begin
00709 CheckIndex( Index);
00710 SetFieldType( Index, DT_BIGINT or 1, SizeOf( Int64));
00711 with FSQLDA.sqlvar[Index] do
00712 begin
00713 case sqlType and $FFFE of
00714 DT_SMALLINT,
00715 DT_UNSSMALLINT : PSmallint(sqldata)^ := Value;
00716 DT_INT,
00717 DT_UNSINT : PInteger(sqldata)^ := Value;
00718 DT_FLOAT : PSingle(sqldata)^ := Value;
00719 DT_DOUBLE : PDouble(sqldata)^ := Value;
00720 DT_VARCHAR : begin
00721 PZASASQLSTRING( sqlData).length :=
00722 Length( IntToStr( Value));
00723 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00724 IntToStr( Value), sqllen-3);
00725 end;
00726 DT_TINYINT,
00727 DT_BIT : PByte(sqldata)^ := Value;
00728 DT_BIGINT,
00729 DT_UNSBIGINT : PInt64(sqldata)^ := Value;
00730 else
00731 CreateException( SUnsupportedParameterType);
00732 end;
00733 if (sqlind <> nil) then sqlind^ := 0;
00734 end;
00735 end;
00736
00737 {**
00738 Set up parameter Float value
00739 @param Index the target parameter index
00740 @param Value the source value
00741 }
00742 procedure TZASASQLDA.UpdateFloat(const Index: Integer; Value: Single);
00743 begin
00744 CheckIndex( Index);
00745 SetFieldType( Index, DT_FLOAT or 1, SizeOf( Single));
00746 with FSQLDA.sqlvar[Index] do
00747 begin
00748 case sqlType and $FFFE of
00749 DT_SMALLINT,
00750 DT_UNSSMALLINT : PSmallint(sqldata)^ := Trunc( Value);
00751 DT_INT,
00752 DT_UNSINT : PInteger(sqldata)^ := Trunc( Value);
00753 DT_FLOAT : PSingle(sqldata)^ := Value;
00754 DT_DOUBLE : PDouble(sqldata)^ := Value;
00755 DT_VARCHAR : begin
00756 PZASASQLSTRING( sqlData).length :=
00757 Length( FloatToStr( Value));
00758 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00759 FloatToStr( Value), sqllen-3);
00760 end;
00761 DT_TINYINT,
00762 DT_BIT : PByte(sqldata)^ := Trunc( Value);
00763 DT_BIGINT,
00764 DT_UNSBIGINT : PInt64(sqldata)^ := Trunc( Value);
00765 else
00766 CreateException( SUnsupportedParameterType);
00767 end;
00768 if (sqlind <> nil) then sqlind^ := 0;
00769 end;
00770 end;
00771
00772 {**
00773 Set up parameter Double value
00774 @param Index the target parameter index
00775 @param Value the source value
00776 }
00777 procedure TZASASQLDA.UpdateDouble(const Index: Integer; Value: Double);
00778 begin
00779 CheckIndex( Index);
00780 SetFieldType( Index, DT_DOUBLE or 1, SizeOf( Double));
00781 with FSQLDA.sqlvar[Index] do
00782 begin
00783 case sqlType and $FFFE of
00784 DT_SMALLINT,
00785 DT_UNSSMALLINT : PSmallint(sqldata)^ := Trunc( Value);
00786 DT_INT,
00787 DT_UNSINT : PInteger(sqldata)^ := Trunc( Value);
00788 DT_FLOAT : PSingle(sqldata)^ := Value;
00789 DT_DOUBLE : PDouble(sqldata)^ := Value;
00790 DT_VARCHAR : begin
00791 PZASASQLSTRING( sqlData).length :=
00792 Length( FloatToStr( Value));
00793 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00794 FloatToStr( Value), sqllen-3);
00795 end;
00796 DT_TINYINT,
00797 DT_BIT : PByte(sqldata)^ := Trunc( Value);
00798 DT_BIGINT,
00799 DT_UNSBIGINT : PInt64(sqldata)^ := Trunc( Value);
00800 else
00801 CreateException( SUnsupportedParameterType);
00802 end;
00803 if (sqlind <> nil) then sqlind^ := 0;
00804 end;
00805 end;
00806
00807 {**
00808 Set up parameter BigDecimal value
00809 @param Index the target parameter index
00810 @param Value the source value
00811 }
00812 procedure TZASASQLDA.UpdateBigDecimal(const Index: Integer; Value: Extended);
00813 begin
00814 CheckIndex( Index);
00815 SetFieldType( Index, DT_DOUBLE or 1, SizeOf( Double));
00816 with FSQLDA.sqlvar[Index] do
00817 begin
00818 case sqlType and $FFFE of
00819 DT_SMALLINT,
00820 DT_UNSSMALLINT : PSmallint(sqldata)^ := Trunc( Value);
00821 DT_INT,
00822 DT_UNSINT : PInteger(sqldata)^ := Trunc( Value);
00823 DT_FLOAT : PSingle(sqldata)^ := Value;
00824 DT_DOUBLE : PDouble(sqldata)^ := Value;
00825 DT_VARCHAR : begin
00826 PZASASQLSTRING( sqlData).length :=
00827 Length( FloatToStr( Value));
00828 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00829 FloatToStr( Value), sqllen-3);
00830 end;
00831 DT_TINYINT,
00832 DT_BIT : PByte(sqldata)^ := Trunc( Value);
00833 DT_BIGINT,
00834 DT_UNSBIGINT : PInt64(sqldata)^ := Trunc( Value);
00835 else
00836 CreateException( SUnsupportedParameterType);
00837 end;
00838 if (sqlind <> nil) then sqlind^ := 0;
00839 end;
00840 end;
00841
00842 {**
00843 Set up parameter PChar value
00844 @param Index the target parameter index
00845 @param Value the source value
00846 }
00847 procedure TZASASQLDA.UpdatePChar(const Index: Integer; Value: PChar);
00848 var
00849 BlobSize: Integer;
00850 begin
00851 CheckIndex( Index);
00852 BlobSize := StrLen( Value);
00853 if BlobSize < MinBLOBSize then
00854 SetFieldType( Index, DT_VARCHAR or 1, MinBLOBSize - 1)
00855 else
00856 SetFieldType( Index, DT_LONGVARCHAR or 1, BlobSize);
00857 with FSQLDA.sqlvar[Index] do
00858 begin
00859 case sqlType and $FFFE of
00860 DT_VARCHAR : begin
00861 PZASASQLSTRING( sqlData).length := BlobSize;
00862 StrLCopy( @PZASASQLSTRING( sqlData).data[0],
00863 Value, BlobSize);
00864 end;
00865 DT_LONGVARCHAR : begin
00866 StrLCopy( @PZASABlobStruct( sqlData).arr[0], Value,
00867 BlobSize);
00868 PZASABlobStruct( sqlData).stored_len := BlobSize;
00869 PZASABlobStruct( sqlData).untrunc_len := BlobSize;
00870 end;
00871 else
00872 CreateException( SUnsupportedParameterType);
00873 end;
00874 if (sqlind <> nil) then sqlind^ := 0;
00875 end;
00876 end;
00877
00878 {**
00879 Set up parameter String value
00880 @param Index the target parameter index
00881 @param Value the source value
00882 }
00883 procedure TZASASQLDA.UpdateString(const Index: Integer; Value: string);
00884 var
00885 BlobSize: Integer;
00886 begin
00887 CheckIndex( Index);
00888 BlobSize := Length( Value);
00889 if BlobSize < MinBLOBSize then
00890 SetFieldType( Index, DT_VARCHAR or 1, MinBLOBSize - 1)
00891 else
00892 SetFieldType( Index, DT_LONGVARCHAR or 1, BlobSize);
00893 with FSQLDA.sqlvar[Index] do
00894 begin
00895 case sqlType and $FFFE of
00896 DT_VARCHAR : begin
00897 PZASASQLSTRING( sqlData).length := BlobSize;
00898 StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
00899 Value, BlobSize);
00900 end;
00901 DT_LONGVARCHAR : begin
00902 StrPLCopy( @PZASABlobStruct( sqlData).arr[0], Value,
00903 BlobSize);
00904 PZASABlobStruct( sqlData).stored_len := BlobSize;
00905 PZASABlobStruct( sqlData).untrunc_len := BlobSize;
00906 end;
00907 else
00908 CreateException( SUnsupportedParameterType);
00909 end;
00910 if (sqlind <> nil) then sqlind^ := 0;
00911 end;
00912 end;
00913
00914 {**
00915 Set up parameter byte value
00916 @param Index the target parameter index
00917 @param Value the source value
00918 }
00919 procedure TZASASQLDA.UpdateBytes(const Index: Integer; Value: TByteDynArray);
00920 var
00921 BlobSize: Integer;
00922 begin
00923 CheckIndex( Index);
00924 BlobSize := Length( Value);
00925 if BlobSize < MinBLOBSize then
00926 SetFieldType( Index, DT_BINARY or 1, MinBLOBSize - 1)
00927 else
00928 SetFieldType( Index, DT_LONGBINARY or 1, BlobSize);
00929 with FSQLDA.sqlvar[Index] do
00930 begin
00931 case sqlType and $FFFE of
00932 DT_BINARY : begin
00933 PZASASQLSTRING( sqlData).length := BlobSize;
00934 Move( Value[0], PZASASQLSTRING( sqlData).data[0], BlobSize);
00935 end;
00936 DT_LONGBINARY : begin
00937 Move( Value[0], PZASABlobStruct( sqlData).arr[0], BlobSize);
00938 PZASABlobStruct( sqlData).stored_len := BlobSize;
00939 PZASABlobStruct( sqlData).untrunc_len := BlobSize;
00940 end;
00941 else
00942 CreateException( SUnsupportedParameterType);
00943 end;
00944 if (sqlind <> nil) then sqlind^ := 0;
00945 end;
00946 end;
00947
00948 {**
00949 Set up parameter Date value
00950 @param Index the target parameter index
00951 @param Value the source value
00952 }
00953 procedure TZASASQLDA.UpdateDate(const Index: Integer; Value: TDateTime);
00954 begin
00955 UpdateDateTime(Index, Value);
00956 FDeclType[Index].sqlType := DT_DATE;
00957 end;
00958
00959 {**
00960 Set up parameter Time value
00961 @param Index the target parameter index
00962 @param Value the source value
00963 }
00964 procedure TZASASQLDA.UpdateTime(const Index: Integer; Value: TDateTime);
00965 begin
00966 UpdateDateTime(Index, Value);
00967 FDeclType[Index].sqlType := DT_TIME;
00968 end;
00969
00970 {**
00971 Set up parameter DateTime value
00972 @param Index the target parameter index
00973 @param Value the source value
00974 }
00975 procedure TZASASQLDA.UpdateDateTime(const Index: Integer;
00976 Value: TDateTime);
00977 var
00978 y, m, d: word;
00979 hr, min, sec, msec: word;
00980 begin
00981 CheckIndex( Index);
00982 SetFieldType( Index, DT_TIMESTAMP_STRUCT or 1, SizeOf( TZASASQLDateTime));
00983 with FSQLDA.sqlvar[Index] do
00984 begin
00985 case sqlType and $FFFE of
00986 DT_TIMESTAMP_STRUCT : begin
00987 DecodeDate( Value, y, m, d);
00988 DecodeTime( Value, hr, min, sec, msec);
00989 PZASASQLDateTime( sqlData).Year := y;
00990 PZASASQLDateTime( sqlData).Month := m - 1;
00991 PZASASQLDateTime( sqlData).Day := d;
00992 PZASASQLDateTime( sqlData).Hour := hr;
00993 PZASASQLDateTime( sqlData).Minute := min;
00994 PZASASQLDateTime( sqlData).Second := sec;
00995 PZASASQLDateTime( sqlData).MicroSecond :=
00996 msec * 1000;
00997 PZASASQLDateTime( sqlData).Day_of_Week := 0;
00998 PZASASQLDateTime( sqlData).Day_of_Year := 0;
00999 end;
01000 else
01001 CreateException( SUnsupportedParameterType);
01002 end;
01003 if (sqlind <> nil) then sqlind^ := 0;
01004 end;
01005 FDeclType[Index].sqlType := DT_TIMESTAMP;
01006 end;
01007
01008 {**
01009 Set up parameter Timestamp value
01010 @param Index the target parameter index
01011 @param Value the source value
01012 }
01013 procedure TZASASQLDA.UpdateTimestamp(const Index: Integer; Value: TDateTime);
01014 begin
01015 UpdateDateTime(Index, Value);
01016 end;
01017
01018 {**
01019 Set up parameter Type value
01020 @param Index the target parameter index
01021 @param Value the source value
01022 }
01023 procedure TZASASQLDA.UpdateValue(const Index: Word; Value: Variant);
01024 begin
01025 case VarType(Value) of
01026 varEmpty,
01027 varNull : UpdateNull( Index, True);
01028 varSmallint : UpdateShort( Index, Value);
01029 varInteger : UpdateInt( Index, Value);
01030 varSingle : UpdateFloat( Index, Value);
01031 varDouble : UpdateDouble( Index, Value);
01032 varCurrency : UpdateBigDecimal( Index, Value);
01033 varDate : UpdateDateTime( Index, Value);
01034 varStrArg,
01035 varString,
01036 varOleStr : UpdateString( Index, Value);
01037 varBoolean : UpdateBoolean( Index, Value);
01038 varByte : UpdateByte( Index, Value);
01039 {$IFDEF COMPILER6_UP}
01040 varInt64 : UpdateLong( Index, Value);
01041 varShortInt : UpdateByte( Index, Value);
01042 varLongWord : UpdateInt( Index, Value);
01043 varWord : UpdateShort( Index, Value);
01044 {$ENDIF}
01045 else
01046 if VarArrayDimCount( Value) = 1 then
01047 begin
01048 UpdateBytes( Index, VarArrayLock( Value));
01049 VarArrayUnlock( Value);
01050 end else
01051 CreateException( SUnsupportedParameterType);
01052 end;
01053 end;
01054
01055 {**
01056 Write stream to blob field
01057 @param Index an index field number
01058 @param Stream the souse data stream
01059 }
01060 procedure TZASASQLDA.WriteBlob(const Index: Integer; Stream: TStream);
01061 var
01062 BlobSize: Integer;
01063 begin
01064 CheckIndex( Index);
01065 Stream.Position := 0;
01066 BlobSize := Stream.Size;
01067 SetFieldType( Index, DT_LONGBINARY or 1, BlobSize);
01068 with FSQLDA.sqlvar[Index] do
01069 begin
01070 case sqlType and $FFFE of
01071 DT_LONGVARCHAR,
01072 DT_LONGBINARY : begin
01073 Stream.ReadBuffer( PZASABlobStruct( sqlData).arr[0], BlobSize);
01074 Stream.Position := 0;
01075 PZASABlobStruct( sqlData).stored_len := BlobSize;
01076 PZASABlobStruct( sqlData).untrunc_len := BlobSize;
01077 end;
01078 else
01079 CreateException( SUnsupportedParameterType);
01080 end;
01081 if (sqlind <> nil) then sqlind^ := 0;
01082 end;
01083 end;
01084
01085 {**
01086 Indicate field null
01087 @param Index the field index
01088 @return true if fied value NULL overwise false
01089 }
01090 function TZASASQLDA.IsNull(const Index: Integer): Boolean;
01091 begin
01092 CheckIndex( Index);
01093 with FSQLDA.sqlvar[Index] do
01094 Result := Assigned( sqlind) and (sqlind^ < 0);
01095 end;
01096
01097 {**
01098 Indicate sqldata assigned
01099 @param Index the field index
01100 @return true if assigned field data
01101 }
01102 function TZASASQLDA.IsAssigned(const Index: Integer): Boolean;
01103 begin
01104 CheckIndex( Index);
01105 with FSQLDA.sqlvar[Index] do
01106 Result := Assigned( sqldata);
01107 end;
01108
01109 {**
01110 Return BigDecimal field value
01111 @param Index the field index
01112 @return the field BigDecimal value
01113 }
01114 function TZASASQLDA.GetBigDecimal(const Index: Integer): Extended;
01115 var
01116 s: String;
01117 begin
01118 CheckRange(Index);
01119 with FSQLDA.sqlvar[Index] do
01120 begin
01121 Result := 0;
01122 if (sqlind^ < 0) then Exit;
01123
01124 case sqlType and $FFFE of
01125 DT_SMALLINT : Result := PSmallint(sqldata)^;
01126 DT_UNSSMALLINT : Result := PWord(sqldata)^;
01127 DT_INT : Result := PInteger(sqldata)^;
01128 DT_UNSINT : Result := PLongWord(sqldata)^;
01129 DT_FLOAT : Result := PSingle(sqldata)^;
01130 DT_DOUBLE : Result := PDouble(sqldata)^;
01131 DT_VARCHAR : begin
01132 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01133 PZASASQLSTRING( sqlData).length);
01134 Result := StrToFloat( s);
01135 end;
01136 DT_TINYINT,
01137 DT_BIT : Result := PByte(sqldata)^;
01138 DT_BIGINT,
01139 DT_UNSBIGINT : Result := PInt64(sqldata)^;
01140 else
01141 CreateException( Format( SErrorConvertionField,
01142 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01143 end;
01144 end;
01145 end;
01146
01147 {**
01148 Return Boolean field value
01149 @param Index the field index
01150 @return the field boolean value
01151 }
01152 function TZASASQLDA.GetBoolean(const Index: Integer): Boolean;
01153 var
01154 s: String;
01155 begin
01156 CheckRange(Index);
01157 with FSQLDA.sqlvar[Index] do
01158 begin
01159 Result := False;
01160 if (sqlind^ < 0) then Exit;
01161
01162 case sqlType and $FFFE of
01163 DT_SMALLINT : Result := PSmallint(sqldata)^ <> 0;
01164 DT_UNSSMALLINT : Result := PWord(sqldata)^ <> 0;
01165 DT_INT : Result := PInteger(sqldata)^ <> 0;
01166 DT_UNSINT : Result := PLongWord(sqldata)^ <> 0;
01167 DT_FLOAT : Result := PSingle(sqldata)^ <> 0;
01168 DT_DOUBLE : Result := PDouble(sqldata)^ <> 0;
01169 DT_VARCHAR : begin
01170 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01171 PZASASQLSTRING( sqlData).length);
01172 Result := StrToInt( s) = 1;
01173 end;
01174 DT_TINYINT,
01175 DT_BIT : Result := PByte(sqldata)^ <> 0;
01176 DT_BIGINT,
01177 DT_UNSBIGINT : Result := PInt64(sqldata)^ <> 0;
01178 else
01179 CreateException( Format( SErrorConvertionField,
01180 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01181 end;
01182 end;
01183 end;
01184
01185 {**
01186 Return Byte field value
01187 @param Index the field index
01188 @return the field Byte value
01189 }
01190 function TZASASQLDA.GetByte(const Index: Integer): ShortInt;
01191 var
01192 s: String;
01193 begin
01194 CheckRange(Index);
01195 with FSQLDA.sqlvar[Index] do
01196 begin
01197 Result := 0;
01198 if (sqlind^ < 0) then Exit;
01199
01200 case sqlType and $FFFE of
01201 DT_SMALLINT : Result := PSmallint(sqldata)^;
01202 DT_UNSSMALLINT : Result := PWord(sqldata)^;
01203 DT_INT : Result := PInteger(sqldata)^;
01204 DT_UNSINT : Result := PLongWord(sqldata)^;
01205 DT_FLOAT : Result := Trunc( PSingle(sqldata)^);
01206 DT_DOUBLE : Result := Trunc( PDouble(sqldata)^);
01207 DT_VARCHAR : begin
01208 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01209 PZASASQLSTRING( sqlData).length);
01210 Result := StrToInt( s);
01211 end;
01212 DT_TINYINT,
01213 DT_BIT : Result := PByte(sqldata)^;
01214 DT_BIGINT,
01215 DT_UNSBIGINT : Result := PInt64(sqldata)^;
01216 else
01217 CreateException( Format( SErrorConvertionField,
01218 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01219 end;
01220 end;
01221 end;
01222
01223 {**
01224 Return Bytes field value
01225 @param Index the field index
01226 @return the field Bytes value
01227 }
01228 function TZASASQLDA.GetBytes(const Index: Integer): TByteDynArray;
01229 begin
01230 CheckRange(Index);
01231 with FSQLDA.sqlvar[Index] do
01232 begin
01233 Result := nil;
01234 if (sqlind^ < 0) then Exit;
01235
01236 case sqlType and $FFFE of
01237 DT_BINARY : begin
01238 SetLength( Result, PZASASQLSTRING( sqlData).length);
01239 Move( PZASASQLSTRING( sqlData).data[0], Result[0], PZASASQLSTRING( sqlData).length);
01240 end;
01241 else
01242 CreateException( Format( SErrorConvertionField,
01243 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01244 end;
01245 end;
01246 end;
01247
01248 {**
01249 Return Date field value
01250 @param Index the field index
01251 @return the field Date value
01252 }
01253 function TZASASQLDA.GetDate(const Index: Integer): TDateTime;
01254 begin
01255 Result := Trunc( GetTimestamp( Index));
01256 end;
01257
01258 {**
01259 Return Double field value
01260 @param Index the field index
01261 @return the field Double value
01262 }
01263 function TZASASQLDA.GetDouble(const Index: Integer): Double;
01264 var
01265 s: String;
01266 begin
01267 CheckRange(Index);
01268 with FSQLDA.sqlvar[Index] do
01269 begin
01270 Result := 0;
01271 if (sqlind^ < 0) then Exit;
01272
01273 case sqlType and $FFFE of
01274 DT_SMALLINT : Result := PSmallint(sqldata)^;
01275 DT_UNSSMALLINT : Result := PWord(sqldata)^;
01276 DT_INT : Result := PInteger(sqldata)^;
01277 DT_UNSINT : Result := PLongWord(sqldata)^;
01278 DT_FLOAT : Result := PSingle(sqldata)^;
01279 DT_DOUBLE : Result := PDouble(sqldata)^;
01280 DT_VARCHAR : begin
01281 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01282 PZASASQLSTRING( sqlData).length);
01283 Result := StrToFloat( s);
01284 end;
01285 DT_TINYINT,
01286 DT_BIT : Result := PByte(sqldata)^;
01287 DT_BIGINT,
01288 DT_UNSBIGINT : Result := PInt64(sqldata)^;
01289 else
01290 CreateException( Format( SErrorConvertionField,
01291 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01292 end;
01293 end;
01294 end;
01295
01296 {**
01297 Return Float field value
01298 @param Index the field index
01299 @return the field Float value
01300 }
01301 function TZASASQLDA.GetFloat(const Index: Integer): Single;
01302 var
01303 s: String;
01304 begin
01305 CheckRange(Index);
01306 with FSQLDA.sqlvar[Index] do
01307 begin
01308 Result := 0;
01309 if (sqlind^ < 0) then Exit;
01310
01311 case sqlType and $FFFE of
01312 DT_SMALLINT : Result := PSmallint(sqldata)^;
01313 DT_UNSSMALLINT : Result := PWord(sqldata)^;
01314 DT_INT : Result := PInteger(sqldata)^;
01315 DT_UNSINT : Result := PLongWord(sqldata)^;
01316 DT_FLOAT : Result := PSingle(sqldata)^;
01317 DT_DOUBLE : Result := PDouble(sqldata)^;
01318 DT_VARCHAR : begin
01319 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01320 PZASASQLSTRING( sqlData).length);
01321 Result := StrToFloat( s);
01322 end;
01323 DT_TINYINT,
01324 DT_BIT : Result := PByte(sqldata)^;
01325 DT_BIGINT,
01326 DT_UNSBIGINT : Result := PInt64(sqldata)^;
01327 else
01328 CreateException( Format( SErrorConvertionField,
01329 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01330 end;
01331 end;
01332 end;
01333
01334 {**
01335 Return Integer field value
01336 @param Index the field index
01337 @return the field Integer value
01338 }
01339 function TZASASQLDA.GetInt(const Index: Integer): Integer;
01340 var
01341 s: String;
01342 begin
01343 CheckRange(Index);
01344 with FSQLDA.sqlvar[Index] do
01345 begin
01346 Result := 0;
01347 if (sqlind^ < 0) then Exit;
01348
01349 case sqlType and $FFFE of
01350 DT_SMALLINT : Result := PSmallint(sqldata)^;
01351 DT_UNSSMALLINT : Result := PWord(sqldata)^;
01352 DT_INT : Result := PInteger(sqldata)^;
01353 DT_UNSINT : Result := PLongWord(sqldata)^;
01354 DT_FLOAT : Result := Trunc( PSingle(sqldata)^);
01355 DT_DOUBLE : Result := Trunc( PDouble(sqldata)^);
01356 DT_VARCHAR : begin
01357 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01358 PZASASQLSTRING( sqlData).length);
01359 Result := StrToInt( s);
01360 end;
01361 DT_TINYINT,
01362 DT_BIT : Result := PByte(sqldata)^;
01363 DT_BIGINT,
01364 DT_UNSBIGINT : Result := PInt64(sqldata)^;
01365 else
01366 CreateException( Format( SErrorConvertionField,
01367 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01368 end;
01369 end;
01370 end;
01371
01372 {**
01373 Return Long field value
01374 @param Index the field index
01375 @return the field Long value
01376 }
01377 function TZASASQLDA.GetLong(const Index: Integer): Int64;
01378 var
01379 s: String;
01380 begin
01381 CheckRange(Index);
01382 with FSQLDA.sqlvar[Index] do
01383 begin
01384 Result := 0;
01385 if (sqlind^ < 0) then Exit;
01386
01387 case sqlType and $FFFE of
01388 DT_SMALLINT : Result := PSmallint(sqldata)^;
01389 DT_UNSSMALLINT : Result := PWord(sqldata)^;
01390 DT_INT : Result := PInteger(sqldata)^;
01391 DT_UNSINT : Result := PLongWord(sqldata)^;
01392 DT_FLOAT : Result := Trunc( PSingle(sqldata)^);
01393 DT_DOUBLE : Result := Trunc( PDouble(sqldata)^);
01394 DT_VARCHAR : begin
01395 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01396 PZASASQLSTRING( sqlData).length);
01397 Result := StrToInt64( s);
01398 end;
01399 DT_TINYINT,
01400 DT_BIT : Result := PByte(sqldata)^;
01401 DT_BIGINT,
01402 DT_UNSBIGINT : Result := PInt64(sqldata)^;
01403 else
01404 CreateException( Format( SErrorConvertionField,
01405 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01406 end;
01407 end;
01408 end;
01409
01410 {**
01411 Return Pchar field value
01412 @param Index the field index
01413 @return the field PChar value
01414 }
01415 function TZASASQLDA.GetPChar(const Index: Integer): PChar;
01416 begin
01417 CheckRange(Index);
01418 with FSQLDA.sqlvar[Index] do
01419 begin
01420 Result := nil;
01421 if (sqlind^ < 0) then Exit;
01422
01423 case sqlType and $FFFE of
01424 DT_VARCHAR : begin
01425 GetMem( Result, PZASASQLSTRING( sqlData).length + 1);
01426 StrLCopy( Result, @PZASASQLSTRING( sqlData).data[0],
01427 PZASASQLSTRING( sqlData).length);
01428 end;
01429 else
01430 Result := PChar( GetString( Index));
01431 end;
01432 end;
01433 end;
01434
01435 {**
01436 Return String field value
01437 @param Index the field index
01438 @return the field String value
01439 }
01440 function TZASASQLDA.GetString(const Index: Integer): string;
01441 begin
01442 CheckRange(Index);
01443 with FSQLDA.sqlvar[Index] do
01444 begin
01445 Result := '';
01446 if (sqlind^ < 0) then Exit;
01447
01448 case sqlType and $FFFE of
01449 DT_SMALLINT : Result := IntToStr( PSmallint(sqldata)^);
01450 DT_UNSSMALLINT : Result := IntToStr( PWord(sqldata)^);
01451 DT_INT : Result := IntToStr( PInteger(sqldata)^);
01452 DT_UNSINT : Result := IntToStr( PLongWord(sqldata)^);
01453 DT_FLOAT : Result := FloatToStr( PSingle(sqldata)^);
01454 DT_DOUBLE : Result := FloatToStr( PDouble(sqldata)^);
01455 DT_VARCHAR : SetString( Result, PChar( @PZASASQLSTRING( sqlData).data[0]),
01456 PZASASQLSTRING( sqlData).length);
01457 DT_LONGVARCHAR : ReadBlobToString( Index, Result);
01458 DT_TIMESTAMP_STRUCT : Result := DateToStr( GetTimestamp( Index));
01459 DT_TINYINT : Result := IntToStr( PByte(sqldata)^);
01460 {$IFDEF VER130BELOW}
01461 DT_BIT : Result := BoolToStr( ( PByte(sqldata)^ = 1));
01462 {$ELSE}
01463 DT_BIT : Result := BoolToStr( ( PByte(sqldata)^ = 1), True);
01464 {$ENDIF}
01465 DT_BIGINT,
01466 DT_UNSBIGINT : Result := IntToStr( PInt64(sqldata)^);
01467 else
01468 CreateException( Format( SErrorConvertionField,
01469 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01470 end;
01471 end;
01472 end;
01473
01474 {**
01475 Return Short field value
01476 @param Index the field index
01477 @return the field Short value
01478 }
01479 function TZASASQLDA.GetShort(const Index: Integer): SmallInt;
01480 var
01481 s: String;
01482 begin
01483 CheckRange(Index);
01484 with FSQLDA.sqlvar[Index] do
01485 begin
01486 Result := 0;
01487 if (sqlind^ < 0) then Exit;
01488
01489 case sqlType and $FFFE of
01490 DT_SMALLINT : Result := PSmallint(sqldata)^;
01491 DT_UNSSMALLINT : Result := PWord(sqldata)^;
01492 DT_INT : Result := PInteger(sqldata)^;
01493
01494 DT_FLOAT : Result := Trunc( PSingle(sqldata)^);
01495 DT_DOUBLE : Result := Trunc( PDouble(sqldata)^);
01496 DT_VARCHAR : begin
01497 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01498 PZASASQLSTRING( sqlData).length);
01499 Result := StrToInt( s);
01500 end;
01501 DT_TINYINT,
01502 DT_BIT : Result := PByte(sqldata)^;
01503 DT_BIGINT,
01504 DT_UNSBIGINT : Result := PInt64(sqldata)^;
01505 else
01506 CreateException( Format( SErrorConvertionField,
01507 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01508 end;
01509 end;
01510 end;
01511
01512 {**
01513 Return Time field value
01514 @param Index the field index
01515 @return the field Time value
01516 }
01517 function TZASASQLDA.GetTime(const Index: Integer): TDateTime;
01518 begin
01519 Result := Frac( GetTimestamp( Index));
01520 end;
01521
01522 {**
01523 Return Timestamp field value
01524 @param Index the field index
01525 @return the field Timestamp value
01526 }
01527 function TZASASQLDA.GetTimestamp(const Index: Integer): TDateTime;
01528 begin
01529 CheckRange( Index);
01530 with FSQLDA.sqlvar[Index] do
01531 begin
01532 Result := 0;
01533 if (sqlind^ < 0) then Exit;
01534
01535 case sqlType and $FFFE of
01536 DT_TIMESTAMP_STRUCT : begin
01537 Result := EncodeDate( PZASASQLDateTime( sqlData).Year,
01538 PZASASQLDateTime( sqlData).Month + 1,
01539 PZASASQLDateTime( sqlData).Day) +
01540 EncodeTime( PZASASQLDateTime( sqlData).Hour,
01541 PZASASQLDateTime( sqlData).Minute,
01542 PZASASQLDateTime( sqlData).Second,
01543 PZASASQLDateTime( sqlData).MicroSecond div 1000);
01544 end;
01545 else
01546 CreateException( Format( SErrorConvertionField,
01547 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01548 end;
01549 end;
01550 end;
01551
01552 {**
01553 Return Variant field value
01554 @param Index the field index
01555 @return the field Variant value
01556 }
01557 function TZASASQLDA.GetValue(const Index: Word): Variant;
01558 var
01559 s: String;
01560 begin
01561 CheckRange(Index);
01562 with FSQLDA.sqlvar[Index] do
01563 begin
01564 VarClear(Result);
01565 if (sqlind^ < 0) then Exit;
01566
01567 case sqlType and $FFFE of
01568 DT_SMALLINT : Result := PSmallint(sqldata)^;
01569 DT_UNSSMALLINT : Result := PWord(sqldata)^;
01570 DT_INT : Result := PInteger(sqldata)^;
01571
01572 DT_FLOAT : Result := PSingle(sqldata)^;
01573 DT_DOUBLE : Result := PDouble(sqldata)^;
01574 DT_VARCHAR : begin
01575 SetString( s, PChar( @PZASASQLSTRING( sqlData).data[0]),
01576 PZASASQLSTRING( sqlData).length);
01577 Result := s;
01578 end;
01579 DT_LONGVARCHAR,
01580 DT_LONGBINARY : ReadBlobToVariant(Index, Result);
01581 DT_TIMESTAMP_STRUCT : Result := GetTimeStamp( Index);
01582 DT_TINYINT : Result := PByte(sqldata)^;
01583 DT_BIT : Result := Boolean( PByte(sqldata)^);
01584 {$IFDEF COMPILER6_UP}
01585 DT_BIGINT,
01586 DT_UNSBIGINT : Result := PInt64(sqldata)^;
01587 {$ELSE}
01588 DT_BIGINT,
01589 DT_UNSBIGINT : Result := Integer( PInt64(sqldata)^);
01590 {$ENDIF}
01591 else
01592 CreateException( Format( SErrorConvertionField,
01593 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01594 end;
01595 end;
01596 end;
01597
01598 procedure TZASASQLDA.ReadBlob(const Index: Word; Buffer: Pointer;
01599 Length: LongWord);
01600 var
01601 TempSQLDA: PASASQLDA;
01602 Offs, Rd: LongWord;
01603 const
01604 BlockSize = 32700;
01605 begin
01606 with FSQLDA.sqlvar[Index] do
01607 begin
01608 if ( ( sqlType and $FFFE = DT_LONGVARCHAR) or
01609 ( sqlType and $FFFE = DT_LONGBINARY)) and
01610 ( PZASABlobStruct( sqlData).array_len > 0) then
01611 begin
01612 Assert( PZASABlobStruct( sqlData).array_len = PZASABlobStruct( sqlData).untrunc_len,
01613 'Blob Record is not correctly initialized');
01614 if PZASABlobStruct( sqlData).array_len <> Length then
01615 CreateException( 'Could''nt complete BLOB-Read');
01616 move( PZASABlobStruct( sqlData).arr[0], PChar( Buffer)[0], PZASABlobStruct( sqlData).array_len);
01617 end else begin
01618 TempSQLDA := FPlainDriver.db_alloc_sqlda( 1);
01619 if not Assigned( TempSQLDA) then
01620 CreateException( 'Not enough memory for SQLDA');
01621 try
01622 with TempSQLDA.sqlvar[ 0] do
01623 begin
01624 sqlType := DT_FIXCHAR;
01625 sqlname.length := 0;
01626 sqlname.data[0] := #0;
01627 TempSQLDA.sqld := TempSQLDA.sqln;
01628
01629 sqlData := Buffer;
01630 Offs := 0;
01631 sqllen := Min( BlockSize, Length);
01632 Rd := 0;
01633
01634 while True do
01635 begin
01636 FPlainDriver.db_get_data( FHandle, PChar( FCursorName), Index + 1, Offs, TempSQLDA);
01637 CheckASAError( FPlainDriver, FHandle, lcOther);
01638 if sqlind^ < 0 then
01639 break;
01640 Inc( Rd, sqllen);
01641 if sqlind^ = 0 then
01642 break;
01643 Inc( Offs, sqllen);
01644 Inc( PChar( sqlData), sqllen);
01645 sqllen := Min( BlockSize, Length-Rd);
01646 end;
01647 if Rd <> Length then
01648 CreateException( 'Could''nt complete BLOB-Read');
01649
01650 DriverManager.LogMessage( lcExecute, FPlainDriver.GetProtocol,
01651 Format( 'GET DATA for Column: %s', [ GetFieldName(Index)]));
01652
01653 FPlainDriver.db_free_sqlda( TempSQLDA);
01654 TempSQLDA := nil;
01655 end;
01656 except
01657 if Assigned( TempSQLDA) then
01658 FPlainDriver.db_free_sqlda( TempSQLDA);
01659 raise;
01660 end;
01661 end;
01662 end;
01663 end;
01664
01665 {**
01666 Read blob data to Buffer
01667 @param Index an filed index
01668 @param Str destination string
01669 }
01670 procedure TZASASQLDA.ReadBlobToMem(const Index: Word; var Buffer: Pointer;
01671 var Length: LongWord);
01672 begin
01673 CheckRange(Index);
01674 with FSQLDA.sqlvar[Index] do
01675 begin
01676 Buffer := nil;
01677 Length := 0;
01678 if (sqlind^ < 0) then Exit;
01679
01680 if ( ( sqlType and $FFFE = DT_LONGVARCHAR) or
01681 ( sqlType and $FFFE = DT_LONGBINARY)) then
01682 begin
01683 Length := PZASABlobStruct( sqlData).untrunc_len;
01684 GetMem( Buffer, Length);
01685 ReadBlob( Index, Buffer, Length);
01686 end else
01687 CreateException( Format( SErrorConvertionField,
01688 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01689 end;
01690 end;
01691
01692 {**
01693 Read blob data to string
01694 @param Index an filed index
01695 @param Str destination string
01696 }
01697 procedure TZASASQLDA.ReadBlobToString(const Index: Word; var Str: string);
01698 begin
01699 CheckRange(Index);
01700 with FSQLDA.sqlvar[Index] do
01701 begin
01702 Str := '';
01703 if (sqlind^ < 0) then Exit;
01704
01705 if sqlType and $FFFE = DT_LONGVARCHAR then
01706 begin
01707 SetLength( Str, PZASABlobStruct( sqlData).untrunc_len);
01708 ReadBlob( Index, PChar( Str), Length( Str));
01709 end else
01710 CreateException( Format( SErrorConvertionField,
01711 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01712 end;
01713 end;
01714
01715 {**
01716 Read blob data to stream
01717 @param Index an filed index
01718 @param Stream destination stream object
01719 }
01720 procedure TZASASQLDA.ReadBlobToStream(const Index: Word; Stream: TStream);
01721 begin
01722 CheckRange(Index);
01723 with FSQLDA.sqlvar[Index] do
01724 begin
01725 Stream.Size := 0;
01726 if (sqlind^ < 0) then Exit;
01727
01728 if ( ( sqlType and $FFFE = DT_LONGVARCHAR) or
01729 ( sqlType and $FFFE = DT_LONGBINARY)) and
01730 ( Stream is TMemoryStream) then
01731 begin
01732 Stream.Size := PZASABlobStruct( sqlData).untrunc_len;
01733 ReadBlob( Index, TMemoryStream( Stream).Memory, Stream.Size);
01734 end else
01735 CreateException( Format( SErrorConvertionField,
01736 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01737 end;
01738 end;
01739
01740 {**
01741 Read blob data to variant value
01742 @param Index an filed index
01743 @param Value destination variant value
01744 }
01745 procedure TZASASQLDA.ReadBlobToVariant(const Index: Word;
01746 var Value: Variant);
01747 var
01748 PData: Pointer;
01749 begin
01750 CheckRange(Index);
01751 with FSQLDA.sqlvar[Index] do
01752 begin
01753 Value := Null;
01754 if (sqlind^ < 0) then Exit;
01755
01756 if ( ( sqlType and $FFFE = DT_LONGVARCHAR) or
01757 ( sqlType and $FFFE = DT_LONGBINARY)) then
01758 begin
01759 Value := VarArrayCreate( [ 0, PZASABlobStruct( sqlData).untrunc_len-1], varByte);
01760 PData := VarArrayLock( Value);
01761 try
01762 ReadBlob( Index, PData, PZASABlobStruct( sqlData).untrunc_len);
01763 finally
01764 VarArrayUnlock( Value);
01765 end;
01766 end else
01767 CreateException( Format( SErrorConvertionField,
01768 [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
01769 end;
01770 end;
01771
01772 {**
01773 Converts a ASA native types into ZDBC SQL types.
01774 @param SQLType Field of TASASQLVar structure.
01775 @return a SQL undepended type.
01776 }
01777 function ConvertASATypeToSQLType( SQLType: SmallInt): TZSQLType;
01778 begin
01779 case SQLType and $FFFE of
01780 DT_NOTYPE:
01781 Result := stUnknown;
01782 DT_SMALLINT:
01783 Result := stShort;
01784 DT_INT:
01785 Result := stInteger;
01786 DT_DECIMAL:
01787 Result := stDouble;
01788 DT_FLOAT:
01789 Result := stFloat;
01790 DT_DOUBLE:
01791 Result := stDouble;
01792 DT_DATE:
01793 Result := stDate;
01794 DT_VARIABLE, DT_STRING, DT_FIXCHAR, DT_VARCHAR:
01795 Result := stString;
01796 DT_LONGVARCHAR:
01797 Result := stAsciiStream;
01798 DT_TIME:
01799 Result := stTime;
01800 DT_TIMESTAMP:
01801 Result := stTimestamp;
01802 DT_TIMESTAMP_STRUCT:
01803 Result := stTimestamp;
01804 DT_BINARY:
01805 Result := stBytes;
01806 DT_LONGBINARY:
01807 Result := stBinaryStream;
01808 DT_TINYINT:
01809 Result := stByte;
01810 DT_BIGINT:
01811 Result := stLong;
01812 DT_UNSINT:
01813 Result := stInteger;
01814 DT_UNSSMALLINT:
01815 Result := stShort;
01816 DT_UNSBIGINT:
01817 Result := stLong;
01818 DT_BIT:
01819 Result := stBoolean;
01820 else
01821 Result := stUnknown;
01822 end;
01823 end;
01824
01825 {**
01826 Converts a ASA native type into String.
01827 @param SQLType Field of TASASQLVar structure.
01828 @return type description.
01829 }
01830 function ConvertASATypeToString( SQLType: SmallInt): String;
01831 begin
01832 case SQLType and $FFFE of
01833 DT_SMALLINT:
01834 Result := 'DT_SMALLINT';
01835 DT_INT:
01836 Result := 'DT_INT';
01837 DT_DECIMAL:
01838 Result := 'DT_DECIMAL';
01839 DT_FLOAT:
01840 Result := 'DT_FLOAT';
01841 DT_DOUBLE:
01842 Result := 'DT_DOUBLE';
01843 DT_DATE:
01844 Result := 'DT_DATE';
01845 DT_VARIABLE:
01846 Result := 'DT_VARIABLE';
01847 DT_STRING:
01848 Result := 'DT_STRING';
01849 DT_FIXCHAR:
01850 Result := 'DT_FIXCHAR';
01851 DT_VARCHAR:
01852 Result := 'DT_VARCHAR';
01853 DT_LONGVARCHAR:
01854 Result := 'DT_LONGVARCHAR';
01855 DT_TIME:
01856 Result := 'DT_TIME';
01857 DT_TIMESTAMP:
01858 Result := 'DT_TIMESTAMP';
01859 DT_TIMESTAMP_STRUCT:
01860 Result := 'DT_TIMESTAMP_STRUCT';
01861 DT_BINARY:
01862 Result := 'DT_BINARY';
01863 DT_LONGBINARY:
01864 Result := 'DT_LONGBINARY';
01865 DT_TINYINT:
01866 Result := 'DT_TINYINT';
01867 DT_BIGINT:
01868 Result := 'DT_BIGINT';
01869 DT_UNSINT:
01870 Result := 'DT_UNSINT';
01871 DT_UNSSMALLINT:
01872 Result := 'DT_UNSSMALLINT';
01873 DT_UNSBIGINT:
01874 Result := 'DT_UNSBIGINT';
01875 DT_BIT:
01876 Result := 'DT_BIT';
01877 else
01878 Result := 'Unknown';
01879 end;
01880 end;
01881
01882 {**
01883 Converts an ODBC native types into ZDBC SQL types.
01884 @param FieldType dblibc native field type.
01885 @return a SQL undepended type.
01886 }
01887 function ConvertASAJDBCToSqlType(FieldType: SmallInt): TZSQLType;
01888 begin
01889 case FieldType of
01890 1, 12, -8, -9: Result := stString;
01891 -7: Result := stBoolean;
01892 -6: Result := stByte;
01893 5: Result := stShort;
01894 4: Result := stInteger;
01895 -5 : Result := stLong;
01896 6, 7, 8: Result := stDouble;
01897 2, 3: Result := stDouble;
01898 11, 93: Result := stTimestamp;
01899 -1, -10: Result := stAsciiStream;
01900 -4, -11, 1111: Result := stBinaryStream;
01901 -3, -2: Result := stBytes;
01902 92: Result := stTime;
01903 91: Result := stDate;
01904 else
01905 Result := stUnknown;
01906 end;
01907 end;
01908 {
01909 procedure TSQLTimeStampToASADateTime( DT: TSQLTimeStamp; const ASADT: PZASASQLDateTime);
01910 begin
01911 ASADT.Year := DT.Year;
01912 ASADT.Month := DT.Month - 1;
01913 ASADT.Day := DT.Day;
01914 ASADT.Hour := DT.Hour;
01915 ASADT.Minute := DT.Minute;
01916 ASADT.Second := DT.Second;
01917 ASADT.MicroSecond := DT.Fractions * 10;
01918 ASADT.Day_of_Week := 0;
01919 ASADT.Day_of_Year := 0;
01920 end;
01921
01922 function ASADateTimeToSQLTimeStamp( ASADT: PZASASQLDateTime): TSQLTimeStamp;
01923 begin
01924 DT.Year := ASADT.Year;
01925 DT.Month := ASADT.Month + 1;
01926 DT.Day := ASADT.Day;
01927 DT.Hour := ASADT.Hour;
01928 DT.Minute := ASADT.Minute;
01929 DT.Second := ASADT.Second;
01930 DT.Fractions := ASADT.MicroSecond div 10;
01931 end;
01932 }
01933 {**
01934 Checks for possible sql errors.
01935 @param PlainDriver a MySQL plain driver.
01936 @param Handle a MySQL connection handle.
01937 @param LogCategory a logging category.
01938 @param LogMessage a logging message.
01939 }
01940 procedure CheckASAError( PlainDriver: IZASAPlainDriver;
01941 Handle: PZASASQLCA; LogCategory: TZLoggingCategory; LogMessage: string = '');
01942 var
01943 ErrorBuf: array[0..1024] of Char;
01944 ErrorMessage: string;
01945 begin
01946 if Handle.SqlCode < SQLE_NOERROR then
01947 begin
01948 ErrorMessage := PlainDriver.sqlError_Message( Handle, ErrorBuf, SizeOf( ErrorBuf));
01949
01950 DriverManager.LogError( LogCategory, PlainDriver.GetProtocol, LogMessage,
01951 Handle.SqlCode, ErrorMessage);
01952 raise EZSQLException.CreateWithCode( Handle.SqlCode,
01953 Format(SSQLError1, [ErrorMessage]));
01954 end;
01955 end;
01956
01957 {**
01958 Create CachedResultSet with using TZCachedResultSet and return it.
01959 @param SQL a sql query command
01960 @param Statement a zeos statement object
01961 @param NativeResultSet a native result set
01962 @return cached ResultSet
01963 }
01964 function GetCachedResultSet(SQL: string;
01965 Statement: IZStatement; NativeResultSet: IZResultSet): IZResultSet;
01966 var
01967 CachedResultSet: TZCachedResultSet;
01968 begin
01969 if (Statement.GetResultSetConcurrency <> rcReadOnly)
01970 or (Statement.GetResultSetType <> rtForwardOnly) then
01971 begin
01972 CachedResultSet := TZCachedResultSet.Create( NativeResultSet, SQL, nil);
01973 CachedResultSet.SetResolver( TZASACachedResolver.Create(
01974 Statement, NativeResultSet.GetMetadata));
01975 CachedResultSet.SetConcurrency( Statement.GetResultSetConcurrency);
01976 Result := CachedResultSet;
01977 end else
01978 Result := NativeResultSet;
01979 end;
01980
01981 procedure DescribeCursor( FASAConnection: IZASAConnection; FSQLData: IZASASQLDA;
01982 Cursor, SQL: String);
01983 begin
01984 FSQLData.AllocateSQLDA( StdVars);
01985 with FASAConnection do
01986 begin
01987 GetPlainDriver.db_describe_cursor( GetDBHandle, PChar( Cursor),
01988 FSQLData.GetData, SQL_DESCRIBE_OUTPUT);
01989 ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute, SQL);
01990 if FSQLData.GetData^.sqld <= 0 then
01991 raise EZSQLException.Create( SCanNotRetrieveResultSetData)
01992 else if ( FSQLData.GetData^.sqld > FSQLData.GetData^.sqln) then
01993 begin
01994 FSQLData.AllocateSQLDA( FSQLData.GetData^.sqld);
01995 GetPlainDriver.db_describe_cursor( GetDBHandle, PChar( Cursor),
01996 FSQLData.GetData, SQL_DESCRIBE_OUTPUT);
01997 ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute, SQL);
01998 end;
01999 FSQLData.InitFields;
02000 end;
02001 end;
02002
02003 procedure Prepare( FASAConnection: IZASAConnection; FSQLData, FParamsSQLData: IZASASQLDA;
02004 const SQL: String; StmtNum: PSmallInt; var FPrepared, FMoreResults: Boolean);
02005 begin
02006 with FASAConnection do
02007 begin
02008 if FPrepared then
02009 begin
02010 FParamsSQLData.AllocateSQLDA( StdVars);
02011 FSQLData.AllocateSQLDA( StdVars);
02012 if StmtNum^ <> 0 then
02013 begin
02014 GetPlainDriver.db_dropstmt( GetDBHandle, nil, nil, StmtNum);
02015 StmtNum^ := 0;
02016 end;
02017 end;
02018 try
02019 GetPlainDriver.db_prepare_describe( GetDBHandle, nil, StmtNum,
02020 PChar( SQL), FParamsSQLData.GetData, SQL_PREPARE_DESCRIBE_STMTNUM +
02021 SQL_PREPARE_DESCRIBE_INPUT + SQL_PREPARE_DESCRIBE_VARRESULT, 0);
02022 ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute, SQL);
02023
02024 FMoreResults := GetDBHandle.sqlerrd[2] = 0;
02025
02026 if FParamsSQLData.GetData^.sqld > FParamsSQLData.GetData^.sqln then
02027 begin
02028 FParamsSQLData.AllocateSQLDA( FParamsSQLData.GetData^.sqld);
02029 GetPlainDriver.db_describe( GetDBHandle, nil, StmtNum,
02030 FParamsSQLData.GetData, SQL_DESCRIBE_INPUT);
02031 ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute,
02032 SQL);
02033 end;
02034
02035 if not FMoreResults then
02036 begin
02037 GetPlainDriver.db_describe( GetDBHandle, nil, StmtNum,
02038 FSQLData.GetData, SQL_DESCRIBE_OUTPUT);
02039 ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute,
02040 SQL);
02041 if FSQLData.GetData^.sqld > FSQLData.GetData^.sqln then
02042 begin
02043 FSQLData.AllocateSQLDA( FSQLData.GetData^.sqld);
02044 GetPlainDriver.db_describe( GetDBHandle, nil, StmtNum,
02045 FSQLData.GetData, SQL_DESCRIBE_OUTPUT);
02046 ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute,
02047 SQL);
02048 end;
02049 FSQLData.InitFields;
02050 end;
02051
02052 FPrepared := true;
02053 { Logging SQL Command }
02054 DriverManager.LogMessage( lcExecute, GetPlainDriver.GetProtocol,
02055 'Prepare: '+ SQL);
02056 except
02057 on E: Exception do
02058 begin
02059 if StmtNum^ <> 0 then
02060 GetPlainDriver.db_dropstmt( GetDBHandle, nil, nil, StmtNum);
02061 raise;
02062 end;
02063 end;
02064 end;
02065 end;
02066
02067 procedure PrepareParameters( PlainDriver: IZASAPlainDriver;
02068 InParamValues: TZVariantDynArray; InParamTypes: TZSQLTypeArray;
02069 InParamCount: Integer; ParamSqlData: IZASASQLDA);
02070 var
02071 i: Integer;
02072 TempBlob: IZBlob;
02073 TempStream: TStream;
02074 begin
02075 if InParamCount <> ParamSqlData.GetFieldCount then
02076 raise EZSQLException.Create( SInvalidInputParameterCount);
02077 for i := 0 to ParamSqlData.GetFieldCount-1 do
02078 begin
02079 if DefVarManager.IsNull( InParamValues[i])then
02080 ParamSqlData.UpdateNull( i, True)
02081 else
02082 case InParamTypes[i] of
02083 stBoolean:
02084 ParamSqlData.UpdateBoolean( i,
02085 SoftVarManager.GetAsBoolean( InParamValues[i]));
02086 stByte:
02087 ParamSqlData.UpdateByte( i,
02088 SoftVarManager.GetAsInteger( InParamValues[i]));
02089 stShort:
02090 ParamSqlData.UpdateShort( i,
02091 SoftVarManager.GetAsInteger( InParamValues[i]));
02092 stInteger:
02093 ParamSqlData.UpdateInt( i,
02094 SoftVarManager.GetAsInteger( InParamValues[i]));
02095 stLong:
02096 ParamSqlData.UpdateLong( i,
02097 SoftVarManager.GetAsInteger( InParamValues[i]));
02098 stFloat:
02099 ParamSqlData.UpdateFloat( i,
02100 SoftVarManager.GetAsFloat( InParamValues[i]));
02101 stDouble:
02102 ParamSqlData.UpdateDouble( i,
02103 SoftVarManager.GetAsFloat( InParamValues[i]));
02104 stBigDecimal:
02105 ParamSqlData.UpdateBigDecimal( i,
02106 SoftVarManager.GetAsFloat( InParamValues[i]));
02107 stString:
02108 ParamSqlData.UpdateString( i,
02109 SoftVarManager.GetAsString( InParamValues[i]));
02110 stUnicodeString:
02111 ParamSqlData.UpdateString( i,
02112 SoftVarManager.GetAsUnicodeString( InParamValues[i]));
02113 stBytes:
02114 ParamSqlData.UpdateBytes( i,
02115 StrToBytes(SoftVarManager.GetAsString( InParamValues[i])));
02116 stDate:
02117 ParamSqlData.UpdateDate( i,
02118 SoftVarManager.GetAsDateTime( InParamValues[i]));
02119 stTime:
02120 ParamSqlData.UpdateTime( i,
02121 SoftVarManager.GetAsDateTime( InParamValues[i]));
02122 stTimestamp:
02123 ParamSqlData.UpdateTimestamp( i,
02124 SoftVarManager.GetAsDateTime( InParamValues[i]));
02125 stAsciiStream,
02126 stUnicodeStream,
02127 stBinaryStream:
02128 begin
02129 TempBlob := DefVarManager.GetAsInterface( InParamValues[i]) as IZBlob;
02130 if not TempBlob.IsEmpty then
02131 begin
02132 TempStream := TempBlob.GetStream;
02133 try
02134 ParamSqlData.WriteBlob( i, TempStream);
02135 finally
02136 TempStream.Free;
02137 end;
02138 end;
02139 end;
02140 else
02141 raise EZASAConvertError.Create( SUnsupportedParameterType);
02142 end;
02143 end;
02144 end;
02145
02146 {**
02147 Generate specific length random string and return it
02148 @param Len a length result string
02149 @return random string
02150 }
02151 function RandomString( Len: integer): string;
02152 begin
02153 Result := '';
02154 while Length( Result) < Len do
02155 Result := Result + IntToStr( Trunc( Random( High( Integer))));
02156 if Length( Result) > Len then
02157 Result := Copy( Result, 1, Len);
02158 end;
02159
02160 end.