zeoslib  UNKNOWN
 All Files
ZDbcASAUtils.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { ASA Database Connectivity Classes }
5 { }
6 { Originally written by Sergey Seroukhov }
7 { and Sergey Merkuriev }
8 { }
9 {*********************************************************}
10 
11 {@********************************************************}
12 { Copyright (c) 1999-2012 Zeos Development Group }
13 { }
14 { License Agreement: }
15 { }
16 { This library is distributed in the hope that it will be }
17 { useful, but WITHOUT ANY WARRANTY; without even the }
18 { implied warranty of MERCHANTABILITY or FITNESS FOR }
19 { A PARTICULAR PURPOSE. See the GNU Lesser General }
20 { Public License for more details. }
21 { }
22 { The source code of the ZEOS Libraries and packages are }
23 { distributed under the Library GNU General Public }
24 { License (see the file COPYING / COPYING.ZEOS) }
25 { with the following modification: }
26 { As a special exception, the copyright holders of this }
27 { library give you permission to link this library with }
28 { independent modules to produce an executable, }
29 { regardless of the license terms of these independent }
30 { modules, and to copy and distribute the resulting }
31 { executable under terms of your choice, provided that }
32 { you also meet, for each linked independent module, }
33 { the terms and conditions of the license of that module. }
34 { An independent module is a module which is not derived }
35 { from or based on this library. If you modify this }
36 { library, you may extend this exception to your version }
37 { of the library, but you are not obligated to do so. }
38 { If you do not wish to do so, delete this exception }
39 { statement from your version. }
40 { }
41 { }
42 { The project web site is located on: }
43 { http://zeos.firmos.at (FORUM) }
44 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
45 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
46 { }
47 { http://www.sourceforge.net/projects/zeoslib. }
48 { }
49 { }
50 { Zeos Development Group. }
51 {********************************************************@}
52 
53 unit ZDbcASAUtils;
54 
55 interface
56 
57 {$I ZDbc.inc}
58 
59 uses
60  Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} SysUtils, Types,
61  ZSysUtils, ZDbcIntfs, ZPlainASADriver, ZDbcLogging, ZCompatibility, ZDbcASA,
62  ZDbcStatement, ZVariant, ZPlainASAConstants;
63 
64 const
65  StdVars = 20;
66  MinBLOBSize = 256;
67  BlockSize = 20;
68 
69 type
70  { ASA Error Class}
71  EZASAConvertError = class(Exception);
72 
73  TZASADECLTYPE = record
74  sqlType: SmallInt;
75  sqlLen : Word;
76  end;
77 
78  { Base interface for sqlda }
79  IZASASQLDA = interface
80  ['{7606E8EB-9FC8-4F76-8D91-E23AB96409E1}']
81  procedure AllocateSQLDA( NumVars: Word);
82  procedure InitFields;
83  procedure FreeSQLDA;
84 
85  function GetData: PASASQLDA;
86  function IsBlob(const Index: Word): boolean;
87  function IsNullable(const Index: Word): boolean;
88 
89  function GetFieldCount: Integer;
90  function GetFieldName(const Index: Word): string;
91  function GetFieldIndex(const Name: String): Word;
92  function GetFieldScale(const Index: Word): integer;
93  function GetFieldSqlType(const Index: Word): TZSQLType;
94  function GetFieldLength(const Index: Word): Word;
95 
96  procedure UpdateNull(const Index: Integer; Value: boolean);
97  procedure UpdateBoolean(const Index: Integer; Value: boolean);
98  procedure UpdateByte(const Index: Integer; Value: Byte);
99  procedure UpdateShort(const Index: Integer; Value: SmallInt);
100  procedure UpdateInt(const Index: Integer; Value: Integer);
101  procedure UpdateLong(const Index: Integer; Value: Int64);
102  procedure UpdateFloat(const Index: Integer; Value: Single);
103  procedure UpdateDouble(const Index: Integer; Value: Double);
104  procedure UpdateBigDecimal(const Index: Integer; Value: Extended);
105  procedure UpdatePChar(const Index: Integer; Value: PChar);
106  procedure UpdateString(const Index: Integer; Value: RawByteString);
107  procedure UpdateBytes(const Index: Integer; Value: TByteDynArray);
108  procedure UpdateDate(const Index: Integer; Value: TDateTime);
109  procedure UpdateTime(const Index: Integer; Value: TDateTime);
110  procedure UpdateTimestamp(const Index: Integer; Value: TDateTime);
111  procedure UpdateValue(const Index: Word; Value: Variant);
112  procedure WriteBlob(const Index: Integer; Stream: TStream; const BlobType: TZSQLType);
113 
114  function IsNull(const Index: Integer): Boolean;
115  function IsAssigned(const Index: Integer): Boolean;
116  function GetBoolean(const Index: Integer): Boolean;
117  function GetByte(const Index: Integer): Byte;
118  function GetShort(const Index: Integer): SmallInt;
119  function GetInt(const Index: Integer): Integer;
120  function GetLong(const Index: Integer): Int64;
121  function GetFloat(const Index: Integer): Single;
122  function GetDouble(const Index: Integer): Double;
123  function GetBigDecimal(const Index: Integer): Extended;
124  function GetPChar(const Index: Integer): PAnsiChar;
125  function GetString(const Index: Integer): RawByteString;
126  function GetBytes(const Index: Integer): TByteDynArray;
127  function GetDate(const Index: Integer): TDateTime;
128  function GetTime(const Index: Integer): TDateTime;
129  function GetTimestamp(const Index: Integer): TDateTime;
130  function GetValue(const Index: Word): Variant;
131 
132  procedure ReadBlobToMem(const Index: Word; var Buffer: Pointer; var Length: LongWord);
133  procedure ReadBlobToStream(const Index: Word; Stream: TStream);
134  procedure ReadBlobToString(const Index: Word; var str: RawByteString);
135  procedure ReadBlobToVariant(const Index: Word; var Value: Variant);
136  end;
137 
138  { Base class contain core functions to work with sqlda structure
139  Can allocate memory for sqlda structure get basic information }
140  TZASASQLDA = class (TInterfacedObject, IZASASQLDA)
141  private
142  FConSettings: PZConSettings;
143  FSQLDA: PASASQLDA;
144  FPlainDriver: IZASAPlainDriver;
145  FHandle: PZASASQLCA;
146  FCursorName: AnsiString;
147  procedure CreateException( Msg: string);
148  procedure CheckIndex(const Index: Word);
149  procedure CheckRange(const Index: Word);
150  procedure SetFieldType(const Index: Word; ASAType: Smallint; Len: LongWord;
151  SetDeclType: Boolean = true); overload;
152  procedure SetFieldType(ToSQLDA: PASASQLDA; const Index: Word; ASAType: Smallint; Len: LongWord;
153  SetDeclType: Boolean = true); overload;
154  protected
155  FDeclType: array of TZASADECLTYPE;
156  procedure ReadBlob(const Index: Word; Buffer: Pointer; Length: LongWord);
157  public
158  constructor Create(PlainDriver: IZASAPlainDriver; Handle: PZASASQLCA;
159  CursorName: AnsiString; ConSettings: PZConSettings; NumVars: Word = StdVars);
160  destructor Destroy; override;
161 
162  procedure AllocateSQLDA( NumVars: Word);
163  procedure InitFields;
164  procedure FreeSQLDA;
165 
166  function GetData: PASASQLDA;
167  function IsBlob(const Index: Word): boolean;
168  function IsNullable(const Index: Word): boolean;
169 
170  function GetFieldCount: Integer;
171  function GetFieldName(const Index: Word): string;
172  function GetFieldIndex(const Name: String): Word;
173  function GetFieldScale(const Index: Word): Integer;
174  function GetFieldSqlType(const Index: Word): TZSQLType;
175  function GetFieldLength(const Index: Word): Word;
176 
177  procedure UpdateNull(const Index: Integer; Value: boolean);
178  procedure UpdateBoolean(const Index: Integer; Value: boolean);
179  procedure UpdateByte(const Index: Integer; Value: Byte);
180  procedure UpdateShort(const Index: Integer; Value: SmallInt);
181  procedure UpdateInt(const Index: Integer; Value: Integer);
182  procedure UpdateLong(const Index: Integer; Value: Int64);
183  procedure UpdateFloat(const Index: Integer; Value: Single);
184  procedure UpdateDouble(const Index: Integer; Value: Double);
185  procedure UpdateBigDecimal(const Index: Integer; Value: Extended);
186  procedure UpdatePChar(const Index: Integer; Value: PChar);
187  procedure UpdateString(const Index: Integer; Value: RawByteString);
188  procedure UpdateBytes(const Index: Integer; Value: TByteDynArray);
189  procedure UpdateDate(const Index: Integer; Value: TDateTime);
190  procedure UpdateTime(const Index: Integer; Value: TDateTime);
191  procedure UpdateDateTime(const Index: Integer; Value: TDateTime);
192  procedure UpdateTimestamp(const Index: Integer; Value: TDateTime);
193  procedure UpdateValue(const Index: Word; Value: Variant);
194  procedure WriteBlob(const Index: Integer; Stream: TStream; const BlobType: TZSQLType);
195 
196  function IsNull(const Index: Integer): Boolean;
197  function IsAssigned(const Index: Integer): Boolean;
198  function GetBoolean(const Index: Integer): Boolean;
199  function GetByte(const Index: Integer): Byte;
200  function GetShort(const Index: Integer): SmallInt;
201  function GetInt(const Index: Integer): Integer;
202  function GetLong(const Index: Integer): Int64;
203  function GetFloat(const Index: Integer): Single;
204  function GetDouble(const Index: Integer): Double;
205  function GetBigDecimal(const Index: Integer): Extended;
206  function GetPChar(const Index: Integer): PAnsiChar;
207  function GetString(const Index: Integer): RawByteString;
208  function GetBytes(const Index: Integer): TByteDynArray;
209  function GetDate(const Index: Integer): TDateTime;
210  function GetTime(const Index: Integer): TDateTime;
211  function GetTimestamp(const Index: Integer): TDateTime;
212  function GetValue(const Index: Word): Variant;
213 
214  procedure ReadBlobToMem(const Index: Word; var Buffer: Pointer; var Length: LongWord);
215  procedure ReadBlobToStream(const Index: Word; Stream: TStream);
216  procedure ReadBlobToString(const Index: Word; var str: RawByteString);
217  procedure ReadBlobToVariant(const Index: Word; var Value: Variant);
218  end;
219 
220 {**
221  Converts a ASA native type into ZDBC SQL types.
222  @param FieldHandle a handler to field description structure.
223  @return a SQL undepended type.
224 }
225 function ConvertASATypeToSQLType(const SQLType: SmallInt; const CtrlsCPType: TZControlsCodePage): TZSQLType;
226 
227 {**
228  Converts a ASA native type into String.
229  @param SQLType Field of TASASQLVar structure.
230  @return type description.
231 }
232 function ConvertASATypeToString( SQLType: SmallInt): String;
233 
234 function ConvertASAJDBCToSqlType(const FieldType: SmallInt;
235  CtrlsCPType: TZControlsCodePage): TZSQLType;
236 {
237 procedure TSQLTimeStampToASADateTime( DT: TSQLTimeStamp; const ASADT: PZASASQLDateTime);
238 function ASADateTimeToSQLTimeStamp( ASADT: PZASASQLDateTime): TSQLTimeStamp;
239 }
240 {**
241  Checks for possible sql errors.
242  @param PlainDriver a MySQL plain driver.
243  @param Handle a MySQL connection handle.
244  @param LogCategory a logging category.
245  @param LogMessage a logging message.
246 }
247 procedure CheckASAError(PlainDriver: IZASAPlainDriver;
248  Handle: PZASASQLCA; LogCategory: TZLoggingCategory; LogMessage: string = '';
249  SupressExceptionID: Integer = 0);
250 
251 function GetCachedResultSet(SQL: string;
252  Statement: IZStatement; NativeResultSet: IZResultSet): IZResultSet;
253 
254 procedure DescribeCursor( FASAConnection: IZASAConnection; FSQLData: IZASASQLDA;
255  Cursor: AnsiString; SQL: String);
256 
257 procedure ASAPrepare( FASAConnection: IZASAConnection; FSQLData, FParamsSQLData: IZASASQLDA;
258  const SQL: RawByteString; const LogSQL: String; StmtNum: PSmallInt; var FPrepared, FMoreResults: Boolean);
259 
260 procedure PrepareParameters( PlainDriver: IZASAPlainDriver;
261  InParamValues: TZVariantDynArray; InParamTypes: TZSQLTypeArray;
262  InParamCount: Integer; ParamSqlData: IZASASQLDA;
263  ConSettings: PZConSettings);
264 
265 function RandomString( Len: integer): string;
266 
267 implementation
268 
269 uses Variants, ZMessages, ZDbcCachedResultSet, Math, ZEncoding
270  {$IFDEF WITH_UNITANSISTRINGS}, AnsiStrings{$ENDIF};
271 
272 { TZASASQLDA }
273 
274 procedure TZASASQLDA.CreateException( Msg: string);
275 begin
276  DriverManager.LogError( lcOther, FPlainDriver.GetProtocol, '', -1, Msg);
277  raise EZSQLException.Create( Format( SSQLError1, [ Msg]));
278 end;
279 
280 {**
281  Check range count fields. If index out of range raised exception.
282  @param Index the index field
283 }
284 procedure TZASASQLDA.CheckIndex(const Index: Word);
285 begin
286  Assert( Assigned( FSQLDA), 'SQLDA not initialized.');
287  Assert( Index < Word(FSQLDA.sqld), 'Out of Range.');
288 end;
289 
290 procedure TZASASQLDA.CheckRange(const Index: Word);
291 begin
292  CheckIndex( Index);
293  Assert( Assigned( FSQLDA.sqlVar[ Index].sqlData),
294  'No memory for variable in SQLDA.');
295 end;
296 
297 procedure TZASASQLDA.SetFieldType(ToSQLDA: PASASQLDA; const Index: Word;
298  ASAType: Smallint; Len: LongWord; SetDeclType: Boolean = true);
299 begin
300  CheckIndex(Index);
301  with ToSQLDA.sqlvar[Index] do
302  begin
303  if ( ASAType and $FFFE = DT_LONGBINARY) or
304  ( ASAType and $FFFE = DT_LONGNVARCHAR) or
305  ( ASAType and $FFFE = DT_LONGVARCHAR) then
306  begin
307  if Assigned( sqlData) then
308  ReallocMem( sqlData, SizeOf( TZASABlobStruct) + Len)
309  else
310  GetMem( sqlData, SizeOf( TZASABlobStruct) + Len);
311  PZASABlobStruct( sqlData).array_len := Len;
312  PZASABlobStruct( sqlData).stored_len := 0;
313  PZASABlobStruct( sqlData).untrunc_len := 0;
314  PZASABlobStruct( sqlData).arr[0] := #0;
315  Inc( Len, SizeOf( TZASABlobStruct));
316  end
317  else
318  begin
319  if ( ASAType and $FFFE = DT_BINARY) or
320  ( ASAType and $FFFE = DT_VARCHAR) then
321  Inc( Len, SizeOf( TZASASQLSTRING));
322  if Assigned( sqlData) then
323  ReallocMem( sqlData, Len)
324  else
325  GetMem( sqlData, Len);
326  if ( ASAType and $FFFE = DT_BINARY) or
327  ( ASAType and $FFFE = DT_VARCHAR) then
328  PZASASQLSTRING( sqlData).length := 0;
329  end;
330  sqlType := ASAType;
331  sqllen := Len;
332  if SetDeclType then
333  begin
334  FDeclType[Index].sqlType := sqlType;
335  FDeclType[Index].sqlLen := sqlLen;
336  end;
337  end;
338 end;
339 
340 procedure TZASASQLDA.SetFieldType(const Index: Word; ASAType: Smallint;
341  Len: LongWord; SetDeclType: Boolean = true);
342 begin
343  SetFieldType(FSQLDA, Index, ASAType, Len, SetDeclType);
344 end;
345 
346 constructor TZASASQLDA.Create(PlainDriver: IZASAPlainDriver; Handle: PZASASQLCA;
347  CursorName: AnsiString; ConSettings: PZConSettings; NumVars: Word = StdVars);
348 begin
349  FPlainDriver := PlainDriver;
350  FHandle := Handle;
351  FCursorName := CursorName;
352  AllocateSQLDA(NumVars);
353  FConSettings := ConSettings;
354  inherited Create;
355 end;
356 
357 destructor TZASASQLDA.Destroy;
358 begin
359  FreeSQLDA;
360  inherited;
361 end;
362 
363 {**
364  Reallocate SQLDA to fields count length
365  @param Value the count fields
366 }
367 procedure TZASASQLDA.AllocateSQLDA( NumVars: Word);
368 begin
369  FreeSQLDA;
370  FSQLDA := FPlainDriver.db_alloc_sqlda( NumVars);
371  if not Assigned( FSQLDA) then
372  CreateException( 'Not enough memory for SQLDA');
373  SetLength(FDeclType, FSQLDA.sqln);
374 end;
375 
376 {**
377  Allocate memory for SQLVar in SQLDA structure for every
378  fields by it length.
379 }
380 procedure TZASASQLDA.InitFields;
381 var
382  i: Integer;
383 begin
384  if Assigned( FSQLDA) then
385  begin
386  for i := 0 to FSQLDA.sqld-1 do
387  begin
388  FDeclType[i].sqlType := FSQLDA.sqlVar[i].sqlType;
389  FDeclType[i].sqlLen := FSQLDA.sqlVar[i].sqlLen;
390  case FSQLDA.sqlVar[i].sqlType and $FFFE of
391  DT_DATE,
392  DT_TIME,
393  DT_TIMESTAMP:
394  begin
395  FSQLDA.sqlVar[i].sqlType := DT_TIMESTAMP_STRUCT +
396  ( FSQLDA.sqlVar[i].sqlType and $0001);
397  FSQLDA.sqlVar[i].sqlLen := SizeOf( TZASASQLDateTime);
398  end;
399  DT_DECIMAL:
400  begin
401  FSQLDA.sqlVar[i].sqlType := DT_DOUBLE +
402  ( FSQLDA.sqlVar[i].sqlType and $0001);
403  FSQLDA.sqlVar[i].sqlLen := SizeOf( Double);
404  end;
405  DT_STRING,
406  DT_FIXCHAR,
407  DT_VARCHAR,
408  DT_LONGVARCHAR: if FSQLDA.sqlVar[i].sqlLen < MinBLOBSize then
409  FSQLDA.sqlVar[i].sqlType := DT_VARCHAR +
410  ( FSQLDA.sqlVar[i].sqlType and $0001)
411  else
412  begin
413  FSQLDA.sqlVar[i].sqlType := DT_LONGVARCHAR +
414  ( FSQLDA.sqlVar[i].sqlType and $0001);
415  FSQLDA.sqlVar[i].sqlLen := 0;
416  end;
417  DT_BINARY,
418  DT_LONGBINARY: if FSQLDA.sqlVar[i].sqlLen < MinBLOBSize then
419  FSQLDA.sqlVar[i].sqlType := DT_BINARY +
420  ( FSQLDA.sqlVar[i].sqlType and $0001)
421  else
422  begin
423  FSQLDA.sqlVar[i].sqlType := DT_LONGBINARY +
424  ( FSQLDA.sqlVar[i].sqlType and $0001);
425  FSQLDA.sqlVar[i].sqlLen := 0;
426  end;
427  end;
428  SetFieldType( i, FSQLDA.sqlVar[i].sqlType, FSQLDA.sqlVar[i].sqlLen, False);
429  end;
430  end;
431 end;
432 
433 {**
434  Clear allocated data for SQLDA parameters
435 }
436 procedure TZASASQLDA.FreeSQLDA;
437 var
438  i: integer;
439 begin
440  if Assigned( FSQLDA) then
441  begin
442  for i := 0 to FSQLDA.sqln-1 do
443  begin
444  FSQLDA.sqlVar[i].sqlInd := nil;
445  if Assigned( FSQLDA.sqlVar[i].sqlData) then
446  begin
447  FreeMem( FSQLDA.sqlVar[i].sqlData);
448  FSQLDA.sqlVar[i].sqlData := nil;
449  end;
450  end;
451  FPlainDriver.db_free_sqlda( FSQLDA);
452  FSQLDA := nil;
453  end;
454  SetLength(FDeclType, 0);
455  FDeclType := nil;
456 end;
457 
458 {**
459  Return pointer to SQLDA structure
460 }
461 function TZASASQLDA.GetData: PASASQLDA;
462 begin
463  Result := FSQLDA;
464 end;
465 
466 {**
467  Indicate blob field
468  @param Index the index fields
469  @return true if blob field overwise false
470 }
471 function TZASASQLDA.IsBlob(const Index: Word): boolean;
472 begin
473  Result := GetFieldSqlType( Index) in
474  [ stAsciiStream, stUnicodeStream, stBinaryStream];
475 end;
476 
477 {**
478  Indicate nullable field
479  @param Index the index fields
480  @return true if field nullable overwise false
481 }
482 function TZASASQLDA.IsNullable(const Index: Word): boolean;
483 begin
484  CheckIndex(Index);
485  Result := FSQLDA.sqlvar[Index].sqlType and 1 = 1
486 end;
487 
488 {**
489  Get fields count not allocated.
490  @return fields count
491 }
492 function TZASASQLDA.GetFieldCount: Integer;
493 begin
494  if Assigned( FSQLDA) then
495  Result := FSQLDA.sqld
496  else
497  Result := 0;
498 end;
499 
500 {**
501  Return Name for field
502  @param Index the index fields
503  @return the name
504 }
505 function TZASASQLDA.GetFieldName(const Index: Word): string;
506 {$IFDEF WITH_RAWBYTESTRING}
507 var Temp: RawByteString;
508 {$ENDIF}
509 begin
510  CheckIndex(Index);
511  {$IFDEF WITH_RAWBYTESTRING}
512  SetLength(Temp, FSQLDA.sqlvar[Index].sqlname.length-1);
513  Move(FSQLDA.sqlvar[Index].sqlname.data, PAnsiChar(Temp)^, FSQLDA.sqlvar[Index].sqlname.length-1);
514  Result := FPlainDriver.ZDbcString(Temp, FConSettings);
515  {$ELSE}
516  SetString( Result, FSQLDA.sqlvar[Index].sqlname.data,
517  FSQLDA.sqlvar[Index].sqlname.length-1);
518  {$ENDIF}
519 end;
520 
521 {**
522  Return field index by it name
523  @param Index the index fields
524  @return the index field
525 }
526 function TZASASQLDA.GetFieldIndex(const Name: String): Word;
527 begin
528  for Result := 0 to FSQLDA.sqld - 1 do
529  if FSQLDA.sqlvar[Result].sqlname.length = Length(name) then
530  if {$IFDEF WITH_STRLICOMP_DEPRECATED}AnsiStrings.{$ENDIF}StrLIComp(@FSQLDA.sqlvar[Result].sqlname.data, PAnsiChar(FPlainDriver.ZPlainString(Name, FConSettings)), Length(name)) = 0 then
531  Exit;
532  CreateException( Format( SFieldNotFound1, [name]));
533  Result := 0; // satisfy compiler
534 end;
535 
536 {**
537  Return field length
538  @param Index the index fields
539  @return the field lenth
540 }
541 function TZASASQLDA.GetFieldLength(const Index: Word): Word;
542 begin
543  CheckIndex( Index);
544  if FSQLDA.sqlvar[Index].sqlType and $FFFE <> DT_DECIMAL then
545  Result := FSQLDA.sqlvar[Index].sqlLen
546  else
547  Result := (FSQLDA.sqlvar[Index].sqlLen and $FF) div 2 + 1;
548 end;
549 
550 {**
551  Return field scale
552  @param Index the index fields
553  @return the field scale
554 }
555 function TZASASQLDA.GetFieldScale(const Index: Word): integer;
556 begin
557  CheckIndex(Index);
558  if FSQLDA.sqlvar[Index].sqlType and $FFFE <> DT_DECIMAL then
559  Result := 0
560  else
561  Result := FSQLDA.sqlvar[Index].sqlLen div 256;
562 end;
563 
564 {**
565  Convert ASA sql type to SQLType
566  @param Index the index fields
567  @return the SQLType
568 }
569 function TZASASQLDA.GetFieldSqlType(const Index: Word): TZSQLType;
570 begin
571  CheckIndex(Index);
572  if FSQLDA.sqlvar[Index].sqlType and $FFFE <> DT_TIMESTAMP_STRUCT then
573  Result := ConvertASATypeToSQLType(FSQLDA.sqlvar[Index].sqlType,
574  FConSettings.CPType)
575  else
576  Result := ConvertASATypeToSQLType( FDeclType[Index].sqlType,
577  FConSettings.CPType)
578 end;
579 
580 {**
581  Set up parameter null value
582  @param Index the target parameter index
583  @param Value the source value
584 }
585 procedure TZASASQLDA.UpdateNull(const Index: Integer; Value: Boolean);
586 begin
587  CheckIndex( Index);
588  with FSQLDA.sqlvar[ Index] do
589  begin
590  if not Assigned( sqlData) then
591  SetFieldType( Index, DT_TINYINT or 1, SizeOf( Byte));
592  if Value then
593  sqlind^ := -1 //NULL
594  else
595  sqlind^ := 0; //NOT NULL
596  end;
597 end;
598 
599 {**
600  Set up parameter Boolean value
601  @param Index the target parameter index
602  @param Value the source value
603 }
604 procedure TZASASQLDA.UpdateBoolean(const Index: Integer; Value: boolean);
605 begin
606  CheckIndex( Index);
607  SetFieldType( Index, DT_BIT or 1, SizeOf( Byte));
608  with FSQLDA.sqlvar[Index] do
609  begin
610  case sqlType and $FFFE of
611  DT_SMALLINT,
612  DT_UNSSMALLINT : PSmallint(sqldata)^ := ord(Value);
613  DT_INT,
614  DT_UNSINT : PInteger(sqldata)^ := ord(Value);
615  DT_FLOAT : PSingle(sqldata)^ := ord(Value);
616  DT_DOUBLE : PDouble(sqldata)^ := ord(Value);
617  DT_VARCHAR:
618  begin
619  PZASASQLSTRING( sqlData).length := 1;
620  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
621  AnsiString(IntToStr(ord(Value))), sqllen-3);
622  end;
623  DT_TINYINT,
624  DT_BIT : PByte(sqldata)^ := ord(Value);
625  DT_BIGINT,
626  DT_UNSBIGINT : PInt64(sqldata)^ := ord(Value);
627  else
628  CreateException( SUnsupportedParameterType);
629  end;
630  if (sqlind <> nil) then
631  sqlind^ := 0; // not null
632  end;
633 end;
634 
635 {**
636  Set up parameter Byte value
637  @param Index the target parameter index
638  @param Value the source value
639 }
640 procedure TZASASQLDA.UpdateByte(const Index: Integer; Value: Byte);
641 begin
642  CheckIndex( Index);
643  SetFieldType( Index, DT_TINYINT or 1, SizeOf( Byte));
644  with FSQLDA.sqlvar[Index] do
645  begin
646  case sqlType and $FFFE of
647  DT_SMALLINT,
648  DT_UNSSMALLINT : PWord(sqldata)^ := Value; //was PSmallint
649  DT_INT,
650  DT_UNSINT : PInteger(sqldata)^ := Value;
651  DT_FLOAT : PSingle(sqldata)^ := Value;
652  DT_DOUBLE : PDouble(sqldata)^ := Value;
653  DT_VARCHAR:
654  begin
655  PZASASQLSTRING( sqlData).length :=
656  Length( IntToStr( Value));
657  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
658  AnsiString(IntToStr(Value)), sqllen-3);
659  end;
660  DT_TINYINT,
661  DT_BIT : PByte(sqldata)^ := Value;
662  DT_BIGINT,
663  DT_UNSBIGINT : PInt64(sqldata)^ := Value;
664  else
665  CreateException( SUnsupportedParameterType);
666  end;
667  if (sqlind <> nil) then
668  sqlind^ := 0; // not null
669  end;
670 end;
671 
672 {**
673  Set up parameter short value
674  @param Index the target parameter index
675  @param Value the source value
676 }
677 procedure TZASASQLDA.UpdateShort(const Index: Integer; Value: SmallInt);
678 begin
679  CheckIndex( Index);
680  SetFieldType( Index, DT_SMALLINT or 1, SizeOf( SmallInt));
681  with FSQLDA.sqlvar[Index] do
682  begin
683  case sqlType and $FFFE of
684  DT_SMALLINT,
685  DT_UNSSMALLINT : PSmallInt(sqldata)^ := Value;
686  DT_INT,
687  DT_UNSINT : PInteger(sqldata)^ := Value;
688  DT_FLOAT : PSingle(sqldata)^ := Value;
689  DT_DOUBLE : PDouble(sqldata)^ := Value;
690  DT_VARCHAR:
691  begin
692  PZASASQLSTRING( sqlData).length :=
693  Length( IntToStr( Value));
694  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
695  AnsiString(IntToStr(Value)), sqllen-3);
696  end;
697  DT_TINYINT,
698  DT_BIT : PByte(sqldata)^ := Value;
699  DT_BIGINT,
700  DT_UNSBIGINT : PInt64(sqldata)^ := Value;
701  else
702  CreateException( SUnsupportedParameterType);
703  end;
704  if (sqlind <> nil) then
705  sqlind^ := 0; // not null
706  end;
707 end;
708 
709 {**
710  Set up parameter integer value
711  @param Index the target parameter index
712  @param Value the source value
713 }
714 procedure TZASASQLDA.UpdateInt(const Index: Integer; Value: Integer);
715 begin
716  CheckIndex( Index);
717  SetFieldType( Index, DT_INT or 1, SizeOf( Integer));
718  with FSQLDA.sqlvar[Index] do
719  begin
720  case sqlType and $FFFE of
721  DT_SMALLINT,
722  DT_UNSSMALLINT : PSmallint(sqldata)^ := Value;
723  DT_INT,
724  DT_UNSINT : PInteger(sqldata)^ := Value;
725  DT_FLOAT : PSingle(sqldata)^ := Value;
726  DT_DOUBLE : PDouble(sqldata)^ := Value;
727  DT_VARCHAR:
728  begin
729  PZASASQLSTRING( sqlData).length :=
730  Length( IntToStr(Value));
731  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
732  AnsiString(IntToStr( Value)), sqllen-3);
733  end;
734  DT_TINYINT,
735  DT_BIT : PByte(sqldata)^ := Value;
736  DT_BIGINT,
737  DT_UNSBIGINT : PInt64(sqldata)^ := Value;
738  else
739  CreateException( SUnsupportedParameterType);
740  end;
741  if (sqlind <> nil) then
742  sqlind^ := 0; // not null
743  end;
744 end;
745 
746 {**
747  Set up parameter Long value
748  @param Index the target parameter index
749  @param Value the source value
750 }
751 procedure TZASASQLDA.UpdateLong(const Index: integer; Value: Int64);
752 begin
753  CheckIndex( Index);
754  SetFieldType( Index, DT_BIGINT or 1, SizeOf( Int64));
755  with FSQLDA.sqlvar[Index] do
756  begin
757  case sqlType and $FFFE of
758  DT_SMALLINT,
759  DT_UNSSMALLINT : PSmallint(sqldata)^ := Value;
760  DT_INT,
761  DT_UNSINT : PInteger(sqldata)^ := Value;
762  DT_FLOAT : PSingle(sqldata)^ := Value;
763  DT_DOUBLE : PDouble(sqldata)^ := Value;
764  DT_VARCHAR:
765  begin
766  PZASASQLSTRING( sqlData).length :=
767  Length( IntToStr( Value));
768  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
769  AnsiString(IntToStr(Value)), sqllen-3);
770  end;
771  DT_TINYINT,
772  DT_BIT : PByte(sqldata)^ := Value;
773  DT_BIGINT,
774  DT_UNSBIGINT : PInt64(sqldata)^ := Value;
775  else
776  CreateException( SUnsupportedParameterType);
777  end;
778  if (sqlind <> nil) then
779  sqlind^ := 0; // not null
780  end;
781 end;
782 
783 {**
784  Set up parameter Float value
785  @param Index the target parameter index
786  @param Value the source value
787 }
788 procedure TZASASQLDA.UpdateFloat(const Index: Integer; Value: Single);
789 begin
790  CheckIndex( Index);
791  SetFieldType( Index, DT_FLOAT or 1, SizeOf( Single));
792  with FSQLDA.sqlvar[Index] do
793  begin
794  case sqlType and $FFFE of
795  DT_SMALLINT,
796  DT_UNSSMALLINT : PSmallint(sqldata)^ := Trunc( Value);
797  DT_INT,
798  DT_UNSINT : PInteger(sqldata)^ := Trunc( Value);
799  DT_FLOAT : PSingle(sqldata)^ := Value;
800  DT_DOUBLE : PDouble(sqldata)^ := Value;
801  DT_VARCHAR:
802  begin
803  PZASASQLSTRING( sqlData).length :=
804  Length( FloatToStr( Value));
805  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
806  AnsiString(FloatToStr(Value)), sqllen-3);
807  end;
808  DT_TINYINT,
809  DT_BIT : PByte(sqldata)^ := Trunc( Value);
810  DT_BIGINT,
811  DT_UNSBIGINT : PInt64(sqldata)^ := Trunc( Value);
812  else
813  CreateException( SUnsupportedParameterType);
814  end;
815  if (sqlind <> nil) then
816  sqlind^ := 0; // not null
817  end;
818 end;
819 
820 {**
821  Set up parameter Double value
822  @param Index the target parameter index
823  @param Value the source value
824 }
825 procedure TZASASQLDA.UpdateDouble(const Index: Integer; Value: Double);
826 begin
827  CheckIndex( Index);
828  SetFieldType( Index, DT_DOUBLE or 1, SizeOf( Double));
829  with FSQLDA.sqlvar[Index] do
830  begin
831  case sqlType and $FFFE of
832  DT_SMALLINT,
833  DT_UNSSMALLINT : PSmallint(sqldata)^ := Trunc( Value);
834  DT_INT,
835  DT_UNSINT : PInteger(sqldata)^ := Trunc( Value);
836  DT_FLOAT : PSingle(sqldata)^ := Value;
837  DT_DOUBLE : PDouble(sqldata)^ := Value;
838  DT_VARCHAR:
839  begin
840  PZASASQLSTRING( sqlData).length :=
841  Length( FloatToStr( Value));
842  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
843  AnsiString(FloatToStr( Value)), sqllen-3);
844  end;
845  DT_TINYINT,
846  DT_BIT : PByte(sqldata)^ := Trunc( Value);
847  DT_BIGINT,
848  DT_UNSBIGINT : PInt64(sqldata)^ := Trunc( Value);
849  else
850  CreateException( SUnsupportedParameterType);
851  end;
852  if (sqlind <> nil) then
853  sqlind^ := 0; // not null
854  end;
855 end;
856 
857 {**
858  Set up parameter BigDecimal value
859  @param Index the target parameter index
860  @param Value the source value
861 }
862 procedure TZASASQLDA.UpdateBigDecimal(const Index: Integer; Value: Extended);
863 begin
864  CheckIndex( Index);
865  SetFieldType( Index, DT_DOUBLE or 1, SizeOf( Double));
866  with FSQLDA.sqlvar[Index] do
867  begin
868  case sqlType and $FFFE of
869  DT_SMALLINT,
870  DT_UNSSMALLINT : PSmallint(sqldata)^ := Trunc( Value);
871  DT_INT,
872  DT_UNSINT : PInteger(sqldata)^ := Trunc( Value);
873  DT_FLOAT : PSingle(sqldata)^ := Value;
874  DT_DOUBLE : PDouble(sqldata)^ := Value;
875  DT_VARCHAR:
876  begin
877  PZASASQLSTRING( sqlData).length :=
878  Length( FloatToStr( Value));
879  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
880  AnsiString(FloatToStr( Value)), sqllen-3);
881  end;
882  DT_TINYINT,
883  DT_BIT : PByte(sqldata)^ := Trunc( Value);
884  DT_BIGINT,
885  DT_UNSBIGINT : PInt64(sqldata)^ := Trunc( Value);
886  else
887  CreateException( SUnsupportedParameterType);
888  end;
889  if (sqlind <> nil) then
890  sqlind^ := 0; // not null
891  end;
892 end;
893 
894 {**
895  Set up parameter PAnsiChar value
896  @param Index the target parameter index
897  @param Value the source value
898 }
899 procedure TZASASQLDA.UpdatePChar(const Index: Integer; Value: PChar);
900 var
901  BlobSize: Integer;
902  AnsiTmp: RawByteString;
903 begin
904  CheckIndex( Index);
905  AnsiTmp := FPlainDriver.ZPlainString(Value, FConSettings);
906  BlobSize := StrLen( Value);
907  if BlobSize < MinBLOBSize then
908  SetFieldType( Index, DT_VARCHAR or 1, MinBLOBSize - 1)
909  else
910  SetFieldType( Index, DT_LONGVARCHAR or 1, BlobSize);
911  with FSQLDA.sqlvar[Index] do
912  begin
913  case sqlType and $FFFE of
914  DT_VARCHAR:
915  begin
916  PZASASQLSTRING( sqlData).length := BlobSize;
917  {$IFDEF WITH_STRLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrLCopy( @PZASASQLSTRING( sqlData).data[0],
918  PAnsiChar(AnsiTmp), BlobSize);
919  end;
920  DT_LONGVARCHAR:
921  begin
922  {$IFDEF WITH_STRLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrLCopy( @PZASABlobStruct( sqlData).arr[0],
923  PAnsiChar(AnsiTmp), BlobSize);
924  PZASABlobStruct( sqlData).stored_len := BlobSize;
925  PZASABlobStruct( sqlData).untrunc_len := BlobSize;
926  end;
927  else
928  CreateException( SUnsupportedParameterType);
929  end;
930  if (sqlind <> nil) then
931  sqlind^ := 0; // not null
932  end;
933 end;
934 
935 {**
936  Set up parameter String value
937  @param Index the target parameter index
938  @param Value the source value
939 }
940 procedure TZASASQLDA.UpdateString(const Index: Integer; Value: RawByteString);
941 var
942  BlobSize: Integer;
943 begin
944  CheckIndex( Index);
945  BlobSize := Length( Value);
946  if BlobSize < MinBLOBSize then
947  SetFieldType( Index, DT_VARCHAR or 1, MinBLOBSize - 1)
948  else
949  SetFieldType( Index, DT_LONGVARCHAR or 1, BlobSize);
950  with FSQLDA.sqlvar[Index] do
951  begin
952  case sqlType and $FFFE of
953  DT_VARCHAR:
954  begin
955  PZASASQLSTRING( sqlData).length := BlobSize;
956  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASASQLSTRING( sqlData).data[0],
957  Value, BlobSize);
958  end;
959  DT_LONGVARCHAR:
960  begin
961  {$IFDEF WITH_STRPLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrPLCopy( @PZASABlobStruct( sqlData).arr[0], Value,
962  BlobSize);
963  PZASABlobStruct( sqlData).stored_len := BlobSize;
964  PZASABlobStruct( sqlData).untrunc_len := BlobSize;
965  end;
966  else
967  CreateException( SUnsupportedParameterType);
968  end;
969  if (sqlind <> nil) then
970  sqlind^ := 0; // not null
971  end;
972 end;
973 
974 {**
975  Set up parameter byte value
976  @param Index the target parameter index
977  @param Value the source value
978 }
979 procedure TZASASQLDA.UpdateBytes(const Index: Integer; Value: TByteDynArray);
980 var
981  BlobSize: Integer;
982 begin
983  CheckIndex( Index);
984  BlobSize := Length( Value);
985  if BlobSize < MinBLOBSize then
986  SetFieldType( Index, DT_BINARY or 1, MinBLOBSize - 1)
987  else
988  SetFieldType( Index, DT_LONGBINARY or 1, BlobSize);
989  with FSQLDA.sqlvar[Index] do
990  begin
991  case sqlType and $FFFE of
992  DT_BINARY:
993  begin
994  PZASASQLSTRING( sqlData).length := BlobSize;
995  Move( Value[0], PZASASQLSTRING( sqlData).data[0], BlobSize);
996  end;
997  DT_LONGBINARY:
998  begin
999  Move( Value[0], PZASABlobStruct( sqlData).arr[0], BlobSize);
1000  PZASABlobStruct( sqlData).stored_len := BlobSize;
1001  PZASABlobStruct( sqlData).untrunc_len := BlobSize;
1002  end;
1003  else
1004  CreateException( SUnsupportedParameterType);
1005  end;
1006  if (sqlind <> nil) then
1007  sqlind^ := 0; // not null
1008  end;
1009 end;
1010 
1011 {**
1012  Set up parameter Date value
1013  @param Index the target parameter index
1014  @param Value the source value
1015 }
1016 procedure TZASASQLDA.UpdateDate(const Index: Integer; Value: TDateTime);
1017 begin
1018  UpdateDateTime(Index, Value);
1019  FDeclType[Index].sqlType := DT_DATE;
1020 end;
1021 
1022 {**
1023  Set up parameter Time value
1024  @param Index the target parameter index
1025  @param Value the source value
1026 }
1027 procedure TZASASQLDA.UpdateTime(const Index: Integer; Value: TDateTime);
1028 begin
1029  UpdateDateTime(Index, Value);
1030  FDeclType[Index].sqlType := DT_TIME;
1031 end;
1032 
1033 {**
1034  Set up parameter DateTime value
1035  @param Index the target parameter index
1036  @param Value the source value
1037 }
1038 procedure TZASASQLDA.UpdateDateTime(const Index: Integer;
1039  Value: TDateTime);
1040 var
1041  y, m, d: word;
1042  hr, min, sec, msec: word;
1043 begin
1044  CheckIndex( Index);
1045  SetFieldType( Index, DT_TIMESTAMP_STRUCT or 1, SizeOf( TZASASQLDateTime));
1046  with FSQLDA.sqlvar[Index] do
1047  begin
1048  case sqlType and $FFFE of
1049  DT_TIMESTAMP_STRUCT:
1050  begin
1051  DecodeDate( Value, y, m, d);
1052  DecodeTime( Value, hr, min, sec, msec);
1053  PZASASQLDateTime( sqlData).Year := y;
1054  PZASASQLDateTime( sqlData).Month := m - 1;
1055  PZASASQLDateTime( sqlData).Day := d;
1056  PZASASQLDateTime( sqlData).Hour := hr;
1057  PZASASQLDateTime( sqlData).Minute := min;
1058  PZASASQLDateTime( sqlData).Second := sec;
1059  PZASASQLDateTime( sqlData).MicroSecond :=
1060  msec * 1000;
1061  PZASASQLDateTime( sqlData).Day_of_Week := 0;
1062  PZASASQLDateTime( sqlData).Day_of_Year := 0;
1063  end;
1064  else
1065  CreateException( SUnsupportedParameterType);
1066  end;
1067  if (sqlind <> nil) then
1068  sqlind^ := 0; // not null
1069  end;
1070  FDeclType[Index].sqlType := DT_TIMESTAMP;
1071 end;
1072 
1073 {**
1074  Set up parameter Timestamp value
1075  @param Index the target parameter index
1076  @param Value the source value
1077 }
1078 procedure TZASASQLDA.UpdateTimestamp(const Index: Integer; Value: TDateTime);
1079 begin
1080  UpdateDateTime(Index, Value);
1081 end;
1082 
1083 {**
1084  Set up parameter Type value
1085  @param Index the target parameter index
1086  @param Value the source value
1087 }
1088 procedure TZASASQLDA.UpdateValue(const Index: Word; Value: Variant);
1089 begin
1090  case VarType(Value) of
1091  varEmpty,
1092  varNull : UpdateNull( Index, True);
1093  varSmallint : UpdateShort( Index, Value);
1094  varInteger : UpdateInt( Index, Value);
1095  varSingle : UpdateFloat( Index, Value);
1096  varDouble : UpdateDouble( Index, Value);
1097  varCurrency : UpdateBigDecimal( Index, Value);
1098  varDate : UpdateDateTime( Index, Value);
1099  varStrArg,
1100  varString : UpdateString(Index, AnsiString(Value));
1101  varOleStr : UpdateString(Index, FPlainDriver.ZPlainString(WideString(Value), FConSettings));
1102  varBoolean : UpdateBoolean( Index, Value);
1103  varByte : UpdateByte( Index, Value);
1104  varInt64 : UpdateLong( Index, Value);
1105  varShortInt : UpdateByte( Index, Value);
1106  varLongWord : UpdateInt( Index, Value);
1107  varWord : UpdateShort( Index, Value);
1108  else
1109  if VarArrayDimCount( Value) = 1 then
1110  begin
1111  UpdateBytes( Index, VarArrayLock( Value));
1112  VarArrayUnlock( Value);
1113  end
1114  else
1115  CreateException( SUnsupportedParameterType);
1116  end;
1117 end;
1118 
1119 {**
1120  Write stream to blob field
1121  @param Index an index field number
1122  @param Stream the souse data stream
1123 }
1124 procedure TZASASQLDA.WriteBlob(const Index: Integer; Stream: TStream;
1125  const BlobType: TZSQLType);
1126 var
1127  BlobSize: Integer;
1128 begin
1129  CheckIndex( Index);
1130  stream.Position := 0;
1131  BlobSize := stream.Size;
1132  case BlobType of
1133  stAsciiStream: SetFieldType( Index, DT_LONGVARCHAR or 1, BlobSize);
1134  stUnicodeStream: SetFieldType( Index, DT_LONGNVARCHAR or 1, BlobSize);
1135  stBinaryStream: SetFieldType( Index, DT_LONGBINARY or 1, BlobSize);
1136  else
1137  CreateException( SUnsupportedParameterType);
1138  end;
1139  {case FSQLDA.sqlvar[Index].sqlType and $FFFE of
1140  DT_LONGVARCHAR:
1141  SetFieldType( Index, DT_LONGVARCHAR or 1, BlobSize);
1142  DT_LONGBINARY:
1143  SetFieldType( Index, DT_LONGBINARY or 1, BlobSize);
1144  DT_LONGNVARCHAR:
1145  SetFieldType( Index, DT_LONGNVARCHAR or 1, BlobSize);
1146  end;
1147  SetFieldType( Index, DT_LONGBINARY or 1, BlobSize);}
1148  with FSQLDA.sqlvar[Index] do
1149  begin
1150  case sqlType and $FFFE of
1151  DT_LONGVARCHAR, DT_LONGNVARCHAR,
1152  DT_LONGBINARY:
1153  begin
1154  stream.ReadBuffer( PZASABlobStruct( sqlData).arr[0], BlobSize);
1155  stream.Position := 0;
1156  PZASABlobStruct( sqlData).stored_len := BlobSize;
1157  PZASABlobStruct( sqlData).untrunc_len := BlobSize;
1158  end;
1159  else
1160  CreateException( SUnsupportedParameterType);
1161  end;
1162  if (sqlind <> nil) then
1163  sqlind^ := 0; // not null
1164  end;
1165 end;
1166 
1167 {**
1168  Indicate field null
1169  @param Index the field index
1170  @return true if fied value NULL overwise false
1171 }
1172 function TZASASQLDA.IsNull(const Index: Integer): Boolean;
1173 begin
1174  CheckIndex( Index);
1175  with FSQLDA.sqlvar[Index] do
1176  Result := Assigned( sqlind) and (sqlind^ < 0);
1177 end;
1178 
1179 {**
1180  Indicate sqldata assigned
1181  @param Index the field index
1182  @return true if assigned field data
1183 }
1184 function TZASASQLDA.IsAssigned(const Index: Integer): Boolean;
1185 begin
1186  CheckIndex( Index);
1187  with FSQLDA.sqlvar[Index] do
1188  Result := Assigned( sqldata);
1189 end;
1190 
1191 {**
1192  Return BigDecimal field value
1193  @param Index the field index
1194  @return the field BigDecimal value
1195 }
1196 function TZASASQLDA.GetBigDecimal(const Index: Integer): Extended;
1197 var
1198  s: RawByteString;
1199 begin
1200  CheckRange(Index);
1201  with FSQLDA.sqlvar[Index] do
1202  begin
1203  Result := 0;
1204  if (sqlind^ < 0) then
1205  Exit;
1206 
1207  case sqlType and $FFFE of
1208  DT_SMALLINT : Result := PSmallint(sqldata)^;
1209  DT_UNSSMALLINT : Result := PWord(sqldata)^;
1210  DT_INT : Result := PInteger(sqldata)^;
1211  DT_UNSINT : Result := PLongWord(sqldata)^;
1212  DT_FLOAT : Result := PSingle(sqldata)^;
1213  DT_DOUBLE : Result := PDouble(sqldata)^;
1214  DT_VARCHAR:
1215  begin
1216  {$IFDEF WITH_RAWBYTESTRING}
1217  SetLength(s, PZASASQLSTRING( sqlData).length);
1218  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsichar(s)^, PZASASQLSTRING( sqlData).length);
1219  {$ELSE}
1220  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1221  {$ENDIF}
1222  Result := ZStrToFloat(s);
1223  end;
1224  DT_TINYINT,
1225  DT_BIT : Result := PByte(sqldata)^;
1226  DT_BIGINT,
1227  DT_UNSBIGINT : Result := PInt64(sqldata)^;
1228  else
1229  CreateException( Format( SErrorConvertionField,
1230  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1231  end;
1232  end;
1233 end;
1234 
1235 {**
1236  Return Boolean field value
1237  @param Index the field index
1238  @return the field boolean value
1239 }
1240 function TZASASQLDA.GetBoolean(const Index: Integer): Boolean;
1241 var
1242  s: RawByteString;
1243 begin
1244  CheckRange(Index);
1245  with FSQLDA.sqlvar[Index] do
1246  begin
1247  Result := False;
1248  if (sqlind^ < 0) then
1249  Exit;
1250 
1251  case sqlType and $FFFE of
1252  DT_SMALLINT : Result := PSmallint(sqldata)^ <> 0;
1253  DT_UNSSMALLINT : Result := PWord(sqldata)^ <> 0;
1254  DT_INT : Result := PInteger(sqldata)^ <> 0;
1255  DT_UNSINT : Result := PLongWord(sqldata)^ <> 0;
1256  DT_FLOAT : Result := PSingle(sqldata)^ <> 0;
1257  DT_DOUBLE : Result := PDouble(sqldata)^ <> 0;
1258  DT_VARCHAR:
1259  begin
1260  {$IFDEF WITH_RAWBYTESTRING}
1261  SetLength(s, PZASASQLSTRING( sqlData).length);
1262  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(S)^, PZASASQLSTRING( sqlData).length);
1263  {$ELSE}
1264  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1265  {$ENDIF}
1266  Result := StrToInt(String(s)) = 1;
1267  end;
1268  DT_TINYINT,
1269  DT_BIT : Result := PByte(sqldata)^ <> 0;
1270  DT_BIGINT,
1271  DT_UNSBIGINT : Result := PInt64(sqldata)^ <> 0;
1272  else
1273  CreateException( Format( SErrorConvertionField,
1274  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1275  end;
1276  end;
1277 end;
1278 
1279 {**
1280  Return Byte field value
1281  @param Index the field index
1282  @return the field Byte value
1283 }
1284 function TZASASQLDA.GetByte(const Index: Integer): Byte;
1285 var
1286  s: RawByteString;
1287 begin
1288  CheckRange(Index);
1289  with FSQLDA.sqlvar[Index] do
1290  begin
1291  Result := 0;
1292  if (sqlind^ < 0) then
1293  Exit;
1294 
1295  case sqlType and $FFFE of
1296  DT_SMALLINT : Result := PSmallint(sqldata)^;
1297  DT_UNSSMALLINT : Result := PWord(sqldata)^;
1298  DT_INT : Result := PInteger(sqldata)^;
1299  DT_UNSINT : Result := PLongWord(sqldata)^;
1300  DT_FLOAT : Result := Trunc( PSingle(sqldata)^);
1301  DT_DOUBLE : Result := Trunc( PDouble(sqldata)^);
1302  DT_VARCHAR:
1303  begin
1304  {$IFDEF WITH_RAWBYTESTRING}
1305  SetLength(s, PZASASQLSTRING( sqlData).length);
1306  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(S)^, PZASASQLSTRING( sqlData).length);
1307  {$ELSE}
1308  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1309  {$ENDIF}
1310  Result := StrToInt(String(s));
1311  end;
1312  DT_TINYINT,
1313  DT_BIT : Result := PByte(sqldata)^;
1314  DT_BIGINT,
1315  DT_UNSBIGINT : Result := PInt64(sqldata)^;
1316  else
1317  CreateException( Format( SErrorConvertionField,
1318  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1319  end;
1320  end;
1321 end;
1322 
1323 {**
1324  Return Bytes field value
1325  @param Index the field index
1326  @return the field Bytes value
1327 }
1328 function TZASASQLDA.GetBytes(const Index: Integer): TByteDynArray;
1329 begin
1330  CheckRange(Index);
1331  with FSQLDA.sqlvar[Index] do
1332  begin
1333  Result := nil;
1334  if (sqlind^ < 0) then
1335  Exit;
1336 
1337  case sqlType and $FFFE of
1338  DT_BINARY:
1339  begin
1340  SetLength( Result, PZASASQLSTRING( sqlData).length);
1341  Move(PZASASQLSTRING(sqlData).data[0], Result[0], PZASASQLSTRING(sqlData).length);
1342  end;
1343  else
1344  CreateException( Format( SErrorConvertionField,
1345  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1346  end;
1347  end;
1348 end;
1349 
1350 {**
1351  Return Date field value
1352  @param Index the field index
1353  @return the field Date value
1354 }
1355 function TZASASQLDA.GetDate(const Index: Integer): TDateTime;
1356 begin
1357  Result := Trunc( GetTimestamp( Index));
1358 end;
1359 
1360 {**
1361  Return Double field value
1362  @param Index the field index
1363  @return the field Double value
1364 }
1365 function TZASASQLDA.GetDouble(const Index: Integer): Double;
1366 var
1367  s: RawByteString;
1368 begin
1369  CheckRange(Index);
1370  with FSQLDA.sqlvar[Index] do
1371  begin
1372  Result := 0;
1373  if (sqlind^ < 0) then
1374  Exit;
1375 
1376  case sqlType and $FFFE of
1377  DT_SMALLINT : Result := PSmallint(sqldata)^;
1378  DT_UNSSMALLINT : Result := PWord(sqldata)^;
1379  DT_INT : Result := PInteger(sqldata)^;
1380  DT_UNSINT : Result := PLongWord(sqldata)^;
1381  DT_FLOAT : Result := PSingle(sqldata)^;
1382  DT_DOUBLE : Result := PDouble(sqldata)^;
1383  DT_VARCHAR:
1384  begin
1385  {$IFDEF WITH_RAWBYTESTRING}
1386  SetLength(s, PZASASQLSTRING( sqlData).length);
1387  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(S)^, PZASASQLSTRING( sqlData).length);
1388  {$ELSE}
1389  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1390  {$ENDIF}
1391  Result := ZStrToFloat(s);
1392  end;
1393  DT_TINYINT,
1394  DT_BIT : Result := PByte(sqldata)^;
1395  DT_BIGINT,
1396  DT_UNSBIGINT : Result := PInt64(sqldata)^;
1397  else
1398  CreateException( Format( SErrorConvertionField,
1399  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1400  end;
1401  end;
1402 end;
1403 
1404 {**
1405  Return Float field value
1406  @param Index the field index
1407  @return the field Float value
1408 }
1409 function TZASASQLDA.GetFloat(const Index: Integer): Single;
1410 var
1411  s: RawByteString;
1412 begin
1413  CheckRange(Index);
1414  with FSQLDA.sqlvar[Index] do
1415  begin
1416  Result := 0;
1417  if (sqlind^ < 0) then
1418  Exit;
1419 
1420  case sqlType and $FFFE of
1421  DT_SMALLINT : Result := PSmallint(sqldata)^;
1422  DT_UNSSMALLINT : Result := PWord(sqldata)^;
1423  DT_INT : Result := PInteger(sqldata)^;
1424  DT_UNSINT : Result := PLongWord(sqldata)^;
1425  DT_FLOAT : Result := PSingle(sqldata)^;
1426  DT_DOUBLE : Result := PDouble(sqldata)^;
1427  DT_VARCHAR:
1428  begin
1429  {$IFDEF WITH_RAWBYTESTRING}
1430  SetLength(s, PZASASQLSTRING( sqlData).length);
1431  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(S)^, PZASASQLSTRING( sqlData).length);
1432  {$ELSE}
1433  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1434  {$ENDIF}
1435  Result := ZStrToFloat(s);
1436  end;
1437  DT_TINYINT,
1438  DT_BIT : Result := PByte(sqldata)^;
1439  DT_BIGINT,
1440  DT_UNSBIGINT : Result := PInt64(sqldata)^;
1441  else
1442  CreateException( Format( SErrorConvertionField,
1443  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1444  end;
1445  end;
1446 end;
1447 
1448 {**
1449  Return Integer field value
1450  @param Index the field index
1451  @return the field Integer value
1452 }
1453 function TZASASQLDA.GetInt(const Index: Integer): Integer;
1454 var
1455  s: RawByteString;
1456 begin
1457  CheckRange(Index);
1458  with FSQLDA.sqlvar[Index] do
1459  begin
1460  Result := 0;
1461  if (sqlind^ < 0) then
1462  Exit;
1463 
1464  case sqlType and $FFFE of
1465  DT_SMALLINT : Result := PSmallint(sqldata)^;
1466  DT_UNSSMALLINT : Result := PWord(sqldata)^;
1467  DT_INT : Result := PInteger(sqldata)^;
1468  DT_UNSINT : Result := PLongWord(sqldata)^;
1469  DT_FLOAT : Result := Trunc( PSingle(sqldata)^);
1470  DT_DOUBLE : Result := Trunc( PDouble(sqldata)^);
1471  DT_VARCHAR:
1472  begin
1473  {$IFDEF WITH_RAWBYTESTRING}
1474  SetLength(s, PZASASQLSTRING( sqlData).length);
1475  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(S)^, PZASASQLSTRING( sqlData).length);
1476  {$ELSE}
1477  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1478  {$ENDIF}
1479  Result := StrToInt(String(s));
1480  end;
1481  DT_TINYINT,
1482  DT_BIT : Result := PByte(sqldata)^;
1483  DT_BIGINT,
1484  DT_UNSBIGINT : Result := PInt64(sqldata)^;
1485  else
1486  CreateException( Format( SErrorConvertionField,
1487  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1488  end;
1489  end;
1490 end;
1491 
1492 {**
1493  Return Long field value
1494  @param Index the field index
1495  @return the field Long value
1496 }
1497 function TZASASQLDA.GetLong(const Index: Integer): Int64;
1498 var
1499  s: RawByteString;
1500 begin
1501  CheckRange(Index);
1502  with FSQLDA.sqlvar[Index] do
1503  begin
1504  Result := 0;
1505  if (sqlind^ < 0) then
1506  Exit;
1507 
1508  case sqlType and $FFFE of
1509  DT_SMALLINT : Result := PSmallint(sqldata)^;
1510  DT_UNSSMALLINT : Result := PWord(sqldata)^;
1511  DT_INT : Result := PInteger(sqldata)^;
1512  DT_UNSINT : Result := PLongWord(sqldata)^;
1513  DT_FLOAT : Result := Trunc( PSingle(sqldata)^);
1514  DT_DOUBLE : Result := Trunc( PDouble(sqldata)^);
1515  DT_VARCHAR:
1516  begin
1517  {$IFDEF WITH_RAWBYTESTRING}
1518  SetLength(s, PZASASQLSTRING( sqlData).length);
1519  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(S)^, PZASASQLSTRING( sqlData).length);
1520  {$ELSE}
1521  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1522  {$ENDIF}
1523  Result := StrToInt64(String(s));
1524  end;
1525  DT_TINYINT,
1526  DT_BIT : Result := PByte(sqldata)^;
1527  DT_BIGINT,
1528  DT_UNSBIGINT : Result := PInt64(sqldata)^;
1529  else
1530  CreateException( Format( SErrorConvertionField,
1531  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1532  end;
1533  end;
1534 end;
1535 
1536 {**
1537  Return PAnsiChar field value
1538  @param Index the field index
1539  @return the field PAnsiChar value
1540 }
1541 function TZASASQLDA.GetPChar(const Index: Integer): PAnsiChar;
1542 begin
1543  CheckRange(Index);
1544  with FSQLDA.sqlvar[Index] do
1545  begin
1546  Result := nil;
1547  if (sqlind^ < 0) then
1548  Exit;
1549 
1550  case sqlType and $FFFE of
1551  DT_VARCHAR:
1552  begin
1553  GetMem( Result, PZASASQLSTRING( sqlData).length + 1);
1554  {$IFDEF WITH_STRLCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrLCopy( Result, @PZASASQLSTRING( sqlData).data[0], PZASASQLSTRING( sqlData).length);
1555  end;
1556  else
1557  Result := PAnsiChar(GetString(Index));
1558  end;
1559  end;
1560 end;
1561 
1562 {**
1563  Return String field value
1564  @param Index the field index
1565  @return the field String value
1566 }
1567 function TZASASQLDA.GetString(const Index: Integer): RawByteString;
1568 begin
1569  CheckRange(Index);
1570  with FSQLDA.sqlvar[Index] do
1571  begin
1572  Result := '';
1573  if (sqlind^ < 0) then
1574  Exit;
1575 
1576  case sqlType and $FFFE of
1577  DT_SMALLINT : Result := RawByteString(IntToStr( PSmallint(sqldata)^));
1578  DT_UNSSMALLINT : Result := RawByteString(IntToStr( PWord(sqldata)^));
1579  DT_INT : Result := RawByteString(IntToStr( PInteger(sqldata)^));
1580  DT_UNSINT : Result := RawByteString(IntToStr( PLongWord(sqldata)^));
1581  DT_FLOAT : Result := RawByteString(FloatToStr( PSingle(sqldata)^));
1582  DT_DOUBLE : Result := RawByteString(FloatToStr( PDouble(sqldata)^));
1583  DT_VARCHAR :
1584  begin
1585  {$IFDEF WITH_RAWBYTESTRING}
1586  SetLength(Result, PZASASQLSTRING( sqlData).length);
1587  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(Result)^, PZASASQLSTRING( sqlData).length);
1588  {$ELSE}
1589  SetString(Result, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1590  {$ENDIF}
1591  end;
1592  DT_LONGVARCHAR : ReadBlobToString( Index, Result);
1593  DT_TIMESTAMP_STRUCT : Result := RawByteString(DateToStr( GetTimestamp( Index)));
1594  DT_TINYINT : Result := RawByteString(IntToStr( PByte(sqldata)^));
1595  DT_BIT : Result := RawByteString(BoolToStr( ( PByte(sqldata)^ = 1), True));
1596  DT_BIGINT,
1597  DT_UNSBIGINT : Result := RawByteString(IntToStr( PInt64(sqldata)^));
1598  else
1599  CreateException( Format( SErrorConvertionField,
1600  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1601  end;
1602  end;
1603 end;
1604 
1605 {**
1606  Return Short field value
1607  @param Index the field index
1608  @return the field Short value
1609 }
1610 function TZASASQLDA.GetShort(const Index: Integer): SmallInt;
1611 var
1612  s: RawByteString;
1613 begin
1614  CheckRange(Index);
1615  with FSQLDA.sqlvar[Index] do
1616  begin
1617  Result := 0;
1618  if (sqlind^ < 0) then
1619  Exit;
1620 
1621  case sqlType and $FFFE of
1622  DT_SMALLINT : Result := PSmallint(sqldata)^;
1623  DT_UNSSMALLINT : Result := PWord(sqldata)^;
1624  DT_INT : Result := PInteger(sqldata)^;
1625 // DT_UNSINT : Result := PLongWord(sqldata)^;
1626  DT_FLOAT : Result := Trunc( PSingle(sqldata)^);
1627  DT_DOUBLE : Result := Trunc( PDouble(sqldata)^);
1628  DT_VARCHAR:
1629  begin
1630  {$IFDEF WITH_RAWBYTESTRING}
1631  SetLength(s, PZASASQLSTRING( sqlData).length);
1632  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(S)^, PZASASQLSTRING( sqlData).length);
1633  {$ELSE}
1634  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1635  {$ENDIF}
1636  Result := StrToInt(String(s));
1637  end;
1638  DT_TINYINT,
1639  DT_BIT : Result := PByte(sqldata)^;
1640  DT_BIGINT,
1641  DT_UNSBIGINT : Result := PInt64(sqldata)^;
1642  else
1643  CreateException( Format( SErrorConvertionField,
1644  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1645  end;
1646  end;
1647 end;
1648 
1649 {**
1650  Return Time field value
1651  @param Index the field index
1652  @return the field Time value
1653 }
1654 function TZASASQLDA.GetTime(const Index: Integer): TDateTime;
1655 begin
1656  Result := Frac( GetTimestamp( Index));
1657 end;
1658 
1659 {**
1660  Return Timestamp field value
1661  @param Index the field index
1662  @return the field Timestamp value
1663 }
1664 function TZASASQLDA.GetTimestamp(const Index: Integer): TDateTime;
1665 begin
1666  CheckRange( Index);
1667  with FSQLDA.sqlvar[Index] do
1668  begin
1669  Result := 0;
1670  if (sqlind^ < 0) then
1671  Exit;
1672 
1673  case sqlType and $FFFE of
1674  DT_TIMESTAMP_STRUCT:
1675  begin
1676  Result := EncodeDate( PZASASQLDateTime( sqlData).Year,
1677  PZASASQLDateTime( sqlData).Month + 1,
1678  PZASASQLDateTime( sqlData).Day) +
1679  EncodeTime( PZASASQLDateTime( sqlData).Hour,
1680  PZASASQLDateTime( sqlData).Minute,
1681  PZASASQLDateTime( sqlData).Second,
1682  PZASASQLDateTime( sqlData).MicroSecond div 1000);
1683  end;
1684  else
1685  CreateException( Format( SErrorConvertionField,
1686  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1687  end;
1688  end;
1689 end;
1690 
1691 {**
1692  Return Variant field value
1693  @param Index the field index
1694  @return the field Variant value
1695 }
1696 function TZASASQLDA.GetValue(const Index: Word): Variant;
1697 var
1698  s: RawByteString;
1699 begin
1700  CheckRange(Index);
1701  with FSQLDA.sqlvar[Index] do
1702  begin
1703  VarClear(Result);
1704  if (sqlind^ < 0) then
1705  Exit;
1706 
1707  case sqlType and $FFFE of
1708  DT_SMALLINT : Result := PSmallint(sqldata)^;
1709  DT_UNSSMALLINT : Result := PWord(sqldata)^;
1710  DT_INT : Result := PInteger(sqldata)^;
1711 // DT_UNSINT : Result := PLongWord(sqldata)^;
1712  DT_FLOAT : Result := PSingle(sqldata)^;
1713  DT_DOUBLE : Result := PDouble(sqldata)^;
1714  DT_VARCHAR:
1715  begin
1716  {$IFDEF WITH_RAWBYTESTRING}
1717  SetLength(s, PZASASQLSTRING( sqlData).length);
1718  Move(PAnsiChar(@PZASASQLSTRING(sqlData).data[0])^, PAnsiChar(S)^, PZASASQLSTRING( sqlData).length);
1719  {$ELSE}
1720  SetString(s, PAnsiChar(@PZASASQLSTRING(sqlData).data[0]), PZASASQLSTRING( sqlData).length);
1721  {$ENDIF}
1722  Result := s;
1723  end;
1724  DT_LONGVARCHAR,
1725  DT_LONGBINARY : ReadBlobToVariant(Index, Result);
1726  DT_TIMESTAMP_STRUCT : Result := GetTimeStamp( Index);
1727  DT_TINYINT : Result := PByte(sqldata)^;
1728  DT_BIT : Result := Boolean( PByte(sqldata)^);
1729  DT_BIGINT,
1730  DT_UNSBIGINT : Result := PInt64(sqldata)^;
1731  else
1732  CreateException( Format( SErrorConvertionField,
1733  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1734  end;
1735  end;
1736 end;
1737 
1738 procedure TZASASQLDA.ReadBlob(const Index: Word; Buffer: Pointer;
1739  Length: LongWord);
1740 var
1741  TempSQLDA: PASASQLDA;
1742  Offs, Rd: LongWord;
1743 const
1744  BlockSize = 32700;
1745 begin
1746  with FSQLDA.sqlvar[Index] do
1747  begin
1748  if ( ( sqlType and $FFFE = DT_LONGVARCHAR) or
1749  ( sqlType and $FFFE = DT_LONGNVARCHAR) or
1750  ( sqlType and $FFFE = DT_LONGBINARY)) and
1751  ( PZASABlobStruct( sqlData).array_len > 0) then
1752  begin
1753  Assert( PZASABlobStruct( sqlData).array_len = PZASABlobStruct( sqlData).untrunc_len,
1754  'Blob Record is not correctly initialized');
1755  if PZASABlobStruct( sqlData).array_len <> Length then
1756  CreateException( 'Could''nt complete BLOB-Read');
1757  move( PZASABlobStruct( sqlData).arr[0], PAnsiChar( Buffer)[0], PZASABlobStruct( sqlData).array_len);
1758  end
1759  else
1760  begin
1761  TempSQLDA := FPlainDriver.db_alloc_sqlda( 1);
1762  if not Assigned( TempSQLDA) then
1763  CreateException( 'Not enough memory for SQLDA');
1764  try
1765  with TempSQLDA.sqlvar[ 0] do
1766  begin
1767  case Self.GetFieldSqlType(Index) of
1768  stAsciiStream:
1769  SetFieldType(TempSQLDA, 0, DT_LONGVARCHAR, Min( BlockSize, Length));
1770  stUnicodeStream:
1771  SetFieldType(TempSQLDA, 0, DT_LONGNVARCHAR, Min( BlockSize, Length));
1772  stBinaryStream:
1773  SetFieldType(TempSQLDA, 0, DT_LONGBINARY, Min( BlockSize, Length));
1774  else
1775  sqlType := DT_FIXCHAR;
1776  end;
1777  sqlname.length := 0;
1778  sqlname.data[0] := #0;
1779  TempSQLDA.sqld := TempSQLDA.sqln;
1780 
1781  Offs := 0;
1782  Rd := 0;
1783 
1784  while True do
1785  begin
1786  FPlainDriver.db_get_data(FHandle, PAnsiChar(FCursorName), Index + 1, Offs, TempSQLDA);
1787  CheckASAError( FPlainDriver, FHandle, lcOther);
1788  if ( sqlind^ < 0 ) then
1789  break;
1790  Inc( Rd, PZASABlobStruct( sqlData)^.stored_len);
1791  if Offs = 0 then ReallocMem(Buffer, PZASABlobStruct( sqlData)^.untrunc_len);
1792  Move((PZASABlobStruct( sqlData)^.arr[0]), (PAnsiChar(Buffer)+Offs)^, PZASABlobStruct( sqlData)^.stored_len);
1793  if ( sqlind^ = 0 ) or ( RD = Length) then
1794  break;
1795  Inc( Offs, PZASABlobStruct( sqlData)^.stored_len);
1796  sqllen := Min( BlockSize, Length-Rd);
1797  end;
1798  if Rd <> Length then
1799  CreateException( 'Could''nt complete BLOB-Read');
1800 
1801  DriverManager.LogMessage( lcExecute, FPlainDriver.GetProtocol,
1802  Format( 'GET DATA for Column: %s', [ GetFieldName(Index)]));
1803  FreeMem(sqlData, SizeOf(TZASABlobStruct)+Min( BlockSize, Length));
1804  FPlainDriver.db_free_sqlda( TempSQLDA);
1805  TempSQLDA := nil;
1806  end;
1807  except
1808  if Assigned( TempSQLDA) then
1809  FPlainDriver.db_free_sqlda( TempSQLDA);
1810  raise;
1811  end;
1812  end;
1813  end;
1814 end;
1815 
1816 {**
1817  Read blob data to Buffer
1818  @param Index an filed index
1819  @param Str destination string
1820 }
1821 procedure TZASASQLDA.ReadBlobToMem(const Index: Word; var Buffer: Pointer;
1822  var Length: LongWord);
1823 begin
1824  CheckRange(Index);
1825  with FSQLDA.sqlvar[Index] do
1826  begin
1827  Buffer := nil;
1828  Length := 0;
1829  if (sqlind^ < 0) then
1830  Exit;
1831 
1832  if ( ( sqlType and $FFFE = DT_LONGVARCHAR) or
1833  ( sqlType and $FFFE = DT_LONGBINARY)) then
1834  begin
1835  Length := PZASABlobStruct( sqlData).untrunc_len;
1836  GetMem( Buffer, Length);
1837  ReadBlob( Index, Buffer, Length);
1838  end
1839  else
1840  CreateException( Format( SErrorConvertionField,
1841  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1842  end;
1843 end;
1844 
1845 {**
1846  Read blob data to string
1847  @param Index an filed index
1848  @param Str destination string
1849 }
1850 procedure TZASASQLDA.ReadBlobToString(const Index: Word; var Str: RawByteString);
1851 begin
1852  CheckRange(Index);
1853  with FSQLDA.sqlvar[Index] do
1854  begin
1855  Str := '';
1856  if (sqlind^ < 0) then
1857  Exit;
1858 
1859  if sqlType and $FFFE = DT_LONGVARCHAR then
1860  begin
1861  SetLength( Str, PZASABlobStruct( sqlData).untrunc_len);
1862  ReadBlob(Index, PAnsiChar(Str), Length(Str));
1863  end
1864  else
1865  CreateException( Format( SErrorConvertionField,
1866  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1867  end;
1868 end;
1869 
1870 {**
1871  Read blob data to stream
1872  @param Index an filed index
1873  @param Stream destination stream object
1874 }
1875 procedure TZASASQLDA.ReadBlobToStream(const Index: Word; Stream: TStream);
1876 begin
1877  CheckRange(Index);
1878  with FSQLDA.sqlvar[Index] do
1879  begin
1880  Stream.Size := 0;
1881  if (sqlind^ < 0) then
1882  Exit;
1883 
1884  if ( ( sqlType and $FFFE = DT_LONGVARCHAR) or
1885  ( sqlType and $FFFE = DT_LONGBINARY)) and
1886  ( Stream is TMemoryStream) then
1887  begin
1888  Stream.Size := PZASABlobStruct( sqlData).untrunc_len;
1889  ReadBlob( Index, TMemoryStream( Stream).Memory, Stream.Size);
1890  end
1891  else
1892  CreateException( Format( SErrorConvertionField,
1893  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1894  end;
1895 end;
1896 
1897 {**
1898  Read blob data to variant value
1899  @param Index an filed index
1900  @param Value destination variant value
1901 }
1902 procedure TZASASQLDA.ReadBlobToVariant(const Index: Word;
1903  var Value: Variant);
1904 var
1905  PData: Pointer;
1906 begin
1907  CheckRange(Index);
1908  with FSQLDA.sqlvar[Index] do
1909  begin
1910  Value := Null;
1911  if (sqlind^ < 0) then
1912  Exit;
1913 
1914  if ( ( sqlType and $FFFE = DT_LONGVARCHAR) or
1915  ( sqlType and $FFFE = DT_LONGBINARY)) then
1916  begin
1917  Value := VarArrayCreate( [ 0, PZASABlobStruct( sqlData).untrunc_len-1], varByte);
1918  PData := VarArrayLock( Value);
1919  try
1920  ReadBlob( Index, PData, PZASABlobStruct( sqlData).untrunc_len);
1921  finally
1922  VarArrayUnlock( Value);
1923  end;
1924  end
1925  else
1926  CreateException( Format( SErrorConvertionField,
1927  [ GetFieldName(Index), ConvertASATypeToString( sqlType)]));
1928  end;
1929 end;
1930 
1931 {**
1932  Converts a ASA native types into ZDBC SQL types.
1933  @param SQLType Field of TASASQLVar structure.
1934  @return a SQL undepended type.
1935 }
1936 function ConvertASATypeToSQLType(const SQLType: SmallInt;
1937  const CtrlsCPType: TZControlsCodePage): TZSQLType;
1938 begin
1939  case SQLType and $FFFE of
1940  DT_NOTYPE:
1941  Result := stUnknown;
1942  DT_SMALLINT:
1943  Result := stShort;
1944  DT_INT:
1945  Result := stInteger;
1946  DT_DECIMAL:
1947  Result := stDouble; //BCD Fields not supported
1948  DT_FLOAT:
1949  Result := stFloat;
1950  DT_DOUBLE:
1951  Result := stDouble;
1952  DT_DATE:
1953  Result := stDate;
1954  DT_VARIABLE, DT_STRING, DT_FIXCHAR, DT_VARCHAR, DT_NSTRING, DT_NFIXCHAR, DT_NVARCHAR:
1955  if (CtrlsCPType = cCP_UTF16) then
1956  Result := stUnicodeString
1957  else
1958  Result := stString;
1959  DT_LONGVARCHAR, DT_LONGNVARCHAR:
1960  if (CtrlsCPType = cCP_UTF16) then
1961  Result := stUnicodeStream
1962  else
1963  Result := stAsciiStream;
1964  DT_TIME:
1965  Result := stTime;
1966  DT_TIMESTAMP:
1967  Result := stTimestamp;
1968  DT_TIMESTAMP_STRUCT:
1969  Result := stTimestamp;
1970  DT_BINARY:
1971  Result := stBytes;
1972  DT_LONGBINARY:
1973  Result := stBinaryStream;
1974  DT_TINYINT:
1975  Result := stByte;
1976  DT_BIGINT:
1977  Result := stLong;
1978  DT_UNSINT:
1979  Result := stInteger;
1980  DT_UNSSMALLINT:
1981  Result := stShort;
1982  DT_UNSBIGINT:
1983  Result := stLong;
1984  DT_BIT:
1985  Result := stBoolean;
1986  else
1987  Result := stUnknown;
1988  end;
1989 end;
1990 
1991 {**
1992  Converts a ASA native type into String.
1993  @param SQLType Field of TASASQLVar structure.
1994  @return type description.
1995 }
1996 function ConvertASATypeToString( SQLType: SmallInt): String;
1997 begin
1998  case SQLType and $FFFE of
1999  DT_SMALLINT:
2000  Result := 'DT_SMALLINT';
2001  DT_INT:
2002  Result := 'DT_INT';
2003  DT_DECIMAL:
2004  Result := 'DT_DECIMAL'; //BCD Fields not supported
2005  DT_FLOAT:
2006  Result := 'DT_FLOAT';
2007  DT_DOUBLE:
2008  Result := 'DT_DOUBLE';
2009  DT_DATE:
2010  Result := 'DT_DATE';
2011  DT_VARIABLE:
2012  Result := 'DT_VARIABLE';
2013  DT_STRING:
2014  Result := 'DT_STRING';
2015  DT_FIXCHAR:
2016  Result := 'DT_FIXCHAR';
2017  DT_VARCHAR:
2018  Result := 'DT_VARCHAR';
2019  DT_LONGVARCHAR:
2020  Result := 'DT_LONGVARCHAR';
2021  DT_TIME:
2022  Result := 'DT_TIME';
2023  DT_TIMESTAMP:
2024  Result := 'DT_TIMESTAMP';
2025  DT_TIMESTAMP_STRUCT:
2026  Result := 'DT_TIMESTAMP_STRUCT';
2027  DT_BINARY:
2028  Result := 'DT_BINARY';
2029  DT_LONGBINARY:
2030  Result := 'DT_LONGBINARY';
2031  DT_TINYINT:
2032  Result := 'DT_TINYINT';
2033  DT_BIGINT:
2034  Result := 'DT_BIGINT';
2035  DT_UNSINT:
2036  Result := 'DT_UNSINT';
2037  DT_UNSSMALLINT:
2038  Result := 'DT_UNSSMALLINT';
2039  DT_UNSBIGINT:
2040  Result := 'DT_UNSBIGINT';
2041  DT_BIT:
2042  Result := 'DT_BIT';
2043  DT_NSTRING:
2044  Result := 'DT_NSTRING';
2045  DT_NFIXCHAR:
2046  Result := 'DT_NFIXCHAR';
2047  DT_NVARCHAR:
2048  Result := 'DT_NVARCHAR';
2049  DT_LONGNVARCHAR:
2050  Result := 'DT_LONGNVARCHAR';
2051  else
2052  Result := 'Unknown';
2053  end;
2054 end;
2055 
2056 {**
2057  Converts an ODBC native types into ZDBC SQL types.
2058  @param FieldType dblibc native field type.
2059  @return a SQL undepended type.
2060 }
2061 function ConvertASAJDBCToSqlType(const FieldType: SmallInt;
2062  CtrlsCPType: TZControlsCodePage): TZSQLType;
2063 begin
2064  case FieldType of
2065  1, 12, -8, -9:
2066  if (CtrlsCPType = cCP_UTF16) then
2067  Result := stUnicodeString
2068  else
2069  Result := stString;
2070  -7: Result := stBoolean;
2071  -6: Result := stByte;
2072  5: Result := stShort;
2073  4: Result := stInteger;
2074  -5 : Result := stLong;
2075  6, 7, 8: Result := stDouble;
2076  2, 3: Result := stDouble; //BCD Feld
2077  11, 93: Result := stTimestamp;
2078  -1, -10:
2079  if (CtrlsCPType = cCP_UTF16) then
2080  Result := stUnicodeStream
2081  else
2082  Result := stAsciiStream;
2083  -4, -11, 1111: Result := stBinaryStream;
2084  -3, -2: Result := stBytes;
2085  92: Result := stTime;
2086  91: Result := stDate;
2087  else
2088  Result := stUnknown;
2089  end;
2090 end;
2091 {
2092 procedure TSQLTimeStampToASADateTime( DT: TSQLTimeStamp; const ASADT: PZASASQLDateTime);
2093 begin
2094  ASADT.Year := DT.Year;
2095  ASADT.Month := DT.Month - 1;
2096  ASADT.Day := DT.Day;
2097  ASADT.Hour := DT.Hour;
2098  ASADT.Minute := DT.Minute;
2099  ASADT.Second := DT.Second;
2100  ASADT.MicroSecond := DT.Fractions * 10;
2101  ASADT.Day_of_Week := 0;
2102  ASADT.Day_of_Year := 0;
2103 end;
2104 
2105 function ASADateTimeToSQLTimeStamp( ASADT: PZASASQLDateTime): TSQLTimeStamp;
2106 begin
2107  DT.Year := ASADT.Year;
2108  DT.Month := ASADT.Month + 1;
2109  DT.Day := ASADT.Day;
2110  DT.Hour := ASADT.Hour;
2111  DT.Minute := ASADT.Minute;
2112  DT.Second := ASADT.Second;
2113  DT.Fractions := ASADT.MicroSecond div 10;
2114 end;
2115 }
2116 {**
2117  Checks for possible sql errors.
2118  @param PlainDriver a MySQL plain driver.
2119  @param Handle a MySQL connection handle.
2120  @param LogCategory a logging category.
2121  @param LogMessage a logging message.
2122 }
2123 procedure CheckASAError( PlainDriver: IZASAPlainDriver;
2124  Handle: PZASASQLCA; LogCategory: TZLoggingCategory; LogMessage: string = '';
2125  SupressExceptionID: Integer = 0);
2126 var
2127  ErrorBuf: array[0..1024] of AnsiChar;
2128  ErrorMessage: string;
2129 begin
2130  if Handle.SqlCode < SQLE_NOERROR then
2131  begin
2132  ErrorMessage := String(PlainDriver.sqlError_Message( Handle, ErrorBuf, SizeOf( ErrorBuf)));
2133  //SyntaxError Position in SQLCount
2134  if not (SupressExceptionID = Handle.SqlCode ) then
2135  begin
2136  DriverManager.LogError( LogCategory, PlainDriver.GetProtocol, LogMessage,
2137  Handle.SqlCode, ErrorMessage);
2138 
2139  raise EZSQLException.CreateWithCode( Handle.SqlCode,
2140  Format(SSQLError1, [ErrorMessage]));
2141  end;
2142  end;
2143 end;
2144 
2145 {**
2146  Create CachedResultSet with using TZCachedResultSet and return it.
2147  @param SQL a sql query command
2148  @param Statement a zeos statement object
2149  @param NativeResultSet a native result set
2150  @return cached ResultSet
2151 }
2152 function GetCachedResultSet(SQL: string;
2153  Statement: IZStatement; NativeResultSet: IZResultSet): IZResultSet;
2154 var
2155  CachedResultSet: TZCachedResultSet;
2156 begin
2157  if (Statement.GetResultSetConcurrency <> rcReadOnly)
2158  or (Statement.GetResultSetType <> rtForwardOnly) then
2159  begin
2160  CachedResultSet := TZCachedResultSet.Create( NativeResultSet, SQL, nil,
2161  Statement.GetConnection.GetConSettings);
2162  CachedResultSet.SetResolver( TZASACachedResolver.Create(
2163  Statement, NativeResultSet.GetMetadata));
2164  CachedResultSet.SetConcurrency( Statement.GetResultSetConcurrency);
2165  Result := CachedResultSet;
2166  end
2167  else
2168  Result := NativeResultSet;
2169 end;
2170 
2171 procedure DescribeCursor( FASAConnection: IZASAConnection; FSQLData: IZASASQLDA;
2172  Cursor: AnsiString; SQL: String);
2173 begin
2174  FSQLData.AllocateSQLDA( StdVars);
2175  with FASAConnection do
2176  begin
2177  GetPlainDriver.db_describe_cursor(GetDBHandle, PAnsiChar(Cursor), FSQLData.GetData, SQL_DESCRIBE_OUTPUT);
2178  ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute, SQL);
2179  if FSQLData.GetData^.sqld <= 0 then
2180  raise EZSQLException.Create( SCanNotRetrieveResultSetData)
2181  else if ( FSQLData.GetData^.sqld > FSQLData.GetData^.sqln) then
2182  begin
2183  FSQLData.AllocateSQLDA( FSQLData.GetData^.sqld);
2184  GetPlainDriver.db_describe_cursor(GetDBHandle, PAnsiChar(Cursor), FSQLData.GetData, SQL_DESCRIBE_OUTPUT);
2185  ZDbcASAUtils.CheckASAError(GetPlainDriver, GetDBHandle, lcExecute, SQL);
2186  end;
2187  FSQLData.InitFields;
2188  end;
2189 end;
2190 
2191 procedure ASAPrepare( FASAConnection: IZASAConnection; FSQLData, FParamsSQLData: IZASASQLDA;
2192  const SQL: RawByteString; const LogSQL: String; StmtNum: PSmallInt; var FPrepared, FMoreResults: Boolean);
2193 begin
2194  with FASAConnection do
2195  begin
2196  if FPrepared then
2197  begin
2198  FParamsSQLData.AllocateSQLDA( StdVars);
2199  FSQLData.AllocateSQLDA( StdVars);
2200  if StmtNum^ <> 0 then
2201  begin
2202  GetPlainDriver.db_dropstmt( GetDBHandle, nil, nil, StmtNum);
2203  StmtNum^ := 0;
2204  end;
2205  end;
2206  try
2207  GetPlainDriver.db_prepare_describe( GetDBHandle, nil, StmtNum,
2208  PAnsiChar(SQL), FParamsSQLData.GetData, SQL_PREPARE_DESCRIBE_STMTNUM +
2209  SQL_PREPARE_DESCRIBE_INPUT + SQL_PREPARE_DESCRIBE_VARRESULT, 0);
2210  ZDbcASAUtils.CheckASAError(GetPlainDriver, GetDBHandle, lcExecute, LogSQL);
2211 
2212  FMoreResults := GetDBHandle.sqlerrd[2] = 0;
2213 
2214  if FParamsSQLData.GetData^.sqld > FParamsSQLData.GetData^.sqln then
2215  begin
2216  FParamsSQLData.AllocateSQLDA( FParamsSQLData.GetData^.sqld);
2217  GetPlainDriver.db_describe( GetDBHandle, nil, StmtNum,
2218  FParamsSQLData.GetData, SQL_DESCRIBE_INPUT);
2219  ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute, LogSQL);
2220  end;
2221 
2222  if not FMoreResults then
2223  begin
2224  GetPlainDriver.db_describe( GetDBHandle, nil, StmtNum,
2225  FSQLData.GetData, SQL_DESCRIBE_OUTPUT);
2226  ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute, LogSQL);
2227  if FSQLData.GetData^.sqld > FSQLData.GetData^.sqln then
2228  begin
2229  FSQLData.AllocateSQLDA( FSQLData.GetData^.sqld);
2230  GetPlainDriver.db_describe( GetDBHandle, nil, StmtNum,
2231  FSQLData.GetData, SQL_DESCRIBE_OUTPUT);
2232  ZDbcASAUtils.CheckASAError( GetPlainDriver, GetDBHandle, lcExecute, LogSQL);
2233  end;
2234  FSQLData.InitFields;
2235  end;
2236 
2237  FPrepared := true;
2238  { Logging SQL Command }
2239  DriverManager.LogMessage( lcExecute, GetPlainDriver.GetProtocol,
2240  'Prepare: '+ LogSQL);
2241  except
2242  on E: Exception do
2243  begin
2244  if StmtNum^ <> 0 then
2245  GetPlainDriver.db_dropstmt( GetDBHandle, nil, nil, StmtNum);
2246  raise;
2247  end;
2248  end;
2249  end;
2250 end;
2251 
2252 procedure PrepareParameters( PlainDriver: IZASAPlainDriver;
2253  InParamValues: TZVariantDynArray; InParamTypes: TZSQLTypeArray;
2254  InParamCount: Integer; ParamSqlData: IZASASQLDA; ConSettings: PZConSettings);
2255 var
2256  i: Integer;
2257  TempBlob: IZBlob;
2258  TempStream: TStream;
2259 begin
2260  if InParamCount <> ParamSqlData.GetFieldCount then
2261  raise EZSQLException.Create( SInvalidInputParameterCount);
2262  for i := 0 to ParamSqlData.GetFieldCount-1 do
2263  if DefVarManager.IsNull( InParamValues[i])then
2264  ParamSqlData.UpdateNull( i, True)
2265  else
2266  case InParamTypes[i] of
2267  stBoolean:
2268  ParamSqlData.UpdateBoolean( i,
2269  SoftVarManager.GetAsBoolean( InParamValues[i]));
2270  stByte:
2271  ParamSqlData.UpdateByte( i,
2272  SoftVarManager.GetAsInteger( InParamValues[i]));
2273  stShort:
2274  ParamSqlData.UpdateShort( i,
2275  SoftVarManager.GetAsInteger( InParamValues[i]));
2276  stInteger:
2277  ParamSqlData.UpdateInt( i,
2278  SoftVarManager.GetAsInteger( InParamValues[i]));
2279  stLong:
2280  ParamSqlData.UpdateLong( i,
2281  SoftVarManager.GetAsInteger( InParamValues[i]));
2282  stFloat:
2283  ParamSqlData.UpdateFloat( i,
2284  SoftVarManager.GetAsFloat( InParamValues[i]));
2285  stDouble:
2286  ParamSqlData.UpdateDouble( i,
2287  SoftVarManager.GetAsFloat( InParamValues[i]));
2288  stBigDecimal:
2289  ParamSqlData.UpdateBigDecimal( i,
2290  SoftVarManager.GetAsFloat( InParamValues[i]));
2291  stString:
2292  ParamSqlData.UpdateString( i,
2293  PlainDriver.ZPlainString(SoftVarManager.GetAsString( InParamValues[i]), ConSettings));
2294  stUnicodeString:
2295  ParamSqlData.UpdateString( i,
2296  PlainDriver.ZPlainString(SoftVarManager.GetAsUnicodeString( InParamValues[i]), ConSettings));
2297  stBytes:
2298  ParamSqlData.UpdateBytes( i, SoftVarManager.GetAsBytes( InParamValues[i]));
2299  stDate:
2300  ParamSqlData.UpdateDate( i,
2301  SoftVarManager.GetAsDateTime( InParamValues[i]));
2302  stTime:
2303  ParamSqlData.UpdateTime( i,
2304  SoftVarManager.GetAsDateTime( InParamValues[i]));
2305  stTimestamp:
2306  ParamSqlData.UpdateTimestamp( i,
2307  SoftVarManager.GetAsDateTime( InParamValues[i]));
2308  stAsciiStream,
2309  stUnicodeStream,
2310  stBinaryStream:
2311  begin
2312  TempBlob := DefVarManager.GetAsInterface(InParamValues[I]) as IZBlob;
2313  if not TempBlob.IsEmpty then
2314  begin
2315  if (InParamTypes[i] in [stUnicodeStream, stAsciiStream]) then
2316  TempStream := TStringStream.Create(GetValidatedAnsiStringFromBuffer(TempBlob.GetBuffer,
2317  TempBlob.Length, TempBlob.WasDecoded, ConSettings))
2318  else
2319  TempStream := TempBlob.GetStream;
2320  if Assigned(TempStream) then
2321  begin
2322  ParamSqlData.WriteBlob(I, TempStream, InParamTypes[i]);
2323  TempStream.Free;
2324  end;
2325  end;
2326  end;
2327  else
2328  raise EZASAConvertError.Create( SUnsupportedParameterType);
2329  end;
2330 end;
2331 
2332 {**
2333  Generate specific length random string and return it
2334  @param Len a length result string
2335  @return random string
2336 }
2337 function RandomString( Len: integer): string;
2338 begin
2339  Result := '';
2340  while Length( Result) < Len do
2341  Result := Result + IntToStr( Trunc( Random( High( Integer))));
2342  if Length( Result) > Len then
2343  Result := Copy( Result, 1, Len);
2344 end;
2345 
2346 end.
2347