zeoslib  UNKNOWN
 All Files
ZDatasetUtils.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { Dataset utility functions and classes }
5 { }
6 { Originally written by Sergey Seroukhov }
7 { }
8 {*********************************************************}
9 
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
12 { }
13 { License Agreement: }
14 { }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
20 { }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
39 { }
40 { }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
45 { }
46 { http://www.sourceforge.net/projects/zeoslib. }
47 { }
48 { }
49 { Zeos Development Group. }
50 {********************************************************@}
51 
52 unit ZDatasetUtils;
53 
54 interface
55 
56 {$I ZComponent.inc}
57 
58 uses
59  Types, Classes, SysUtils, {$IFDEF MSEgui}mclasses, mdb{$ELSE}Db{$ENDIF},
60  Contnrs, {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings, {$ENDIF}
61  ZDbcIntfs, ZDbcCache, ZCompatibility, ZExpression, ZVariant, ZTokenizer;
62 
63 {**
64  Converts DBC Field Type to TDataset Field Type.
65  @param Value an initial DBC field type.
66  @return a converted TDataset field type.
67 }
68 function ConvertDbcToDatasetType(Value: TZSQLType): TFieldType;
69 
70 {**
71  Converts TDataset Field Type to DBC Field Type.
72  @param Value an initial TDataset field type.
73  @return a converted DBC field type.
74 }
75 function ConvertDatasetToDbcType(Value: TFieldType): TZSQLType;
76 
77 {**
78  Converts field definitions into column information objects.
79  @param Fields a collection of field definitions.
80  @return a collection of column information objects.
81 }
82 function ConvertFieldsToColumnInfo(Fields: TFields): TObjectList;
83 
84 {**
85  Fetches columns from specified resultset.
86  @param ResultSet a source resultset.
87  @param FieldsLookupTable a lookup table to define original index.
88  @param Fields a collection of field definitions.
89  @param RowAccessor a destination row accessor.
90 }
91 procedure FetchFromResultSet(ResultSet: IZResultSet;
92  const FieldsLookupTable: TIntegerDynArray; Fields: TFields;
93  RowAccessor: TZRowAccessor);
94 
95 {**
96  Posts columns from specified resultset.
97  @param ResultSet a source resultset.
98  @param FieldsLookupTable a lookup table to define original index.
99  @param Fields a collection of field definitions.
100  @param RowAccessor a destination row accessor.
101 }
102 procedure PostToResultSet(ResultSet: IZResultSet;
103  const FieldsLookupTable: TIntegerDynArray; Fields: TFields;
104  RowAccessor: TZRowAccessor);
105 
106 {**
107  Defines fields indices for the specified dataset.
108  @param DataSet a dataset object.
109  @param FieldNames a list of field names.
110  @param OnlyDataFields <code>True</code> if only data fields selected.
111 }
112 function DefineFields(DataSet: TDataset; const FieldNames: string;
113  var OnlyDataFields: Boolean): TObjectDynArray;
114 
115 {**
116  Defins a indices of filter fields.
117  @param Dataset a dataset object.
118  @param Expression a expression calculator.
119  @returns an array with field object references.
120 }
121 function DefineFilterFields(DataSet: TDataset;
122  Expression: IZExpression): TObjectDynArray;
123 
124 {**
125  Retrieves a set of specified field values.
126  @param FieldRefs an array with interested field object references.
127  @param ResultSet an initial result set object.
128  @param ResultValues a container for result values.
129  @return an array with field values.
130 }
131 procedure RetrieveDataFieldsFromResultSet(const FieldRefs: TObjectDynArray;
132  ResultSet: IZResultSet; var ResultValues: TZVariantDynArray);
133 
134 {**
135  Retrieves a set of specified field values.
136  @param FieldRefs an array with interested field object references.
137  @param FieldIndices an array with interested field indices.
138  @param RowAccessor a row accessor object.
139  @param ResultValues a container for result values.
140  @return an array with field values.
141 }
142 procedure RetrieveDataFieldsFromRowAccessor(const FieldRefs: TObjectDynArray;
143  const FieldIndices: TIntegerDynArray; RowAccessor: TZRowAccessor;
144  var ResultValues: TZVariantDynArray);
145 
146 {**
147  Copy a set of specified field values to variables.
148  @param Fields an array with interested field object references.
149  @param ResultSet an initial result set object.
150  @param Variables a list of variables.
151 }
152 procedure CopyDataFieldsToVars(const Fields: TObjectDynArray;
153  ResultSet: IZResultSet; Variables: IZVariablesList);
154 
155 {**
156  Prepares values for comparison by CompareFieldsFromResultSet.
157  @param FieldRefs an array with interested field object references.
158  @param DecodedKeyValues given values.
159  @param ResultSet a resultset to get field values.
160  @param PartialKey <code>True</code> if values should be started with the keys.
161  @param CaseInsensitive <code>True</code> if keys are case insensitive.
162 }
163 procedure PrepareValuesForComparison(const FieldRefs: TObjectDynArray;
164  var DecodedKeyValues: TZVariantDynArray; ResultSet: IZResultSet;
165  PartialKey: Boolean; CaseInsensitive: Boolean);
166 
167 {**
168  Compares row field values with the given ones.
169  @param KeyValues given values.
170  @param RowValues row field values.
171  @param PartialKey <code>True</code> if values should be started with the keys.
172  @param CaseInsensitive <code>True</code> if keys are case insensitive.
173  @return <code> if values are equal.
174 }
175 function CompareDataFields(const KeyValues, RowValues: TZVariantDynArray;
176  PartialKey: Boolean; CaseInsensitive: Boolean): Boolean;
177 
178 {**
179  Compares row field values with the given ones.
180  @param FieldRefs an array with interested field object references.
181  @param KeyValues given values.
182  @param RowValues row field values.
183  @param PartialKey <code>True</code> if values should be started with the keys.
184  @param CaseInsensitive <code>True</code> if keys are case insensitive.
185  @return <code> if values are equal.
186 }
187 function CompareFieldsFromResultSet(const FieldRefs: TObjectDynArray;
188  const KeyValues: TZVariantDynArray; ResultSet: IZResultSet; PartialKey: Boolean;
189  CaseInsensitive: Boolean): Boolean;
190 
191 {**
192  Defines a list of key field names.
193  @param Fields a collection of dataset fields.
194  @return a list of key field names.
195 }
196 function DefineKeyFields(Fields: TFields): string;
197 
198 {**
199  Converts datetime value into TDataset internal presentation.
200  @param DataType a type of date-time field.
201  @param Data a data which contains a value.
202  @param Buffer a field buffer pointer
203 }
204 procedure DateTimeToNative(DataType: TFieldType; Data: TDateTime; Buffer: Pointer);
205 
206 {**
207  Converts date times from TDataset internal presentation into datetime value.
208  @param DataType a type of date-time field.
209  @param Buffer a field buffer pointer
210  @return a data which contains a value.
211 }
212 function NativeToDateTime(DataType: TFieldType; Buffer: Pointer): TDateTime;
213 
214 {**
215  Compare values from two key fields.
216  @param Field1 the first field object.
217  @param ResultSet the resultset to read the first field value.
218  @param Field2 the second field object.
219 }
220 function CompareKeyFields(Field1: TField; ResultSet: IZResultSet;
221  Field2: TField): Boolean;
222 
223 {**
224  Defins a indices and directions for sorted fields.
225  @param Dataset a dataset object.
226  @param SortedFields an encoded fields for sorting in the format
227  <Field Name> [ASC | DESC] [, ...]
228  @param FieldRefs a decoded field object references.
229  @param FieldDirs a decoded field directions.
230  @param OnlyDataFields <code>True</code> if only data fields selected.
231 }
232 procedure DefineSortedFields(DataSet: TDataset;
233  const SortedFields: string; var FieldRefs: TObjectDynArray;
234  var FieldDirs: TBooleanDynArray; var OnlyDataFields: Boolean);
235 
236 {**
237  Creates a fields lookup table to define fixed position
238  of the field in dataset.
239  @param Fields a collection of TDataset fields in initial order.
240  @returns a fields lookup table.
241 }
242 function CreateFieldsLookupTable(Fields: TFields): TIntegerDynArray;
243 
244 {**
245  Defines an original field index in the dataset.
246  @param FieldsLookupTable a lookup table to define original index.
247  @param Field a TDataset field object.
248  @returns an original fields index or -1 otherwise.
249 }
250 function DefineFieldIndex(const FieldsLookupTable: TIntegerDynArray;
251  Field: TField): Integer;
252 
253 {**
254  Defines an original field indices in the dataset.
255  @param FieldsLookupTable a lookup table to define original index.
256  @param FieldRefs a TDataset field object references.
257  @returns an array with original fields indices.
258 }
259 function DefineFieldIndices(const FieldsLookupTable: TIntegerDynArray;
260  const FieldRefs: TObjectDynArray): TIntegerDynArray;
261 
262 {**
263  Splits up a qualified object name into pieces. Catalog, schema
264  and objectname.
265 }
266 procedure SplitQualifiedObjectName(QualifiedName: string;
267  var Catalog, Schema, ObjectName: string); overload;
268 
269 {**
270  Splits up a qualified object name into pieces. Catalog, schema
271  and objectname.
272 }
273 procedure SplitQualifiedObjectName(QualifiedName: string;
274  const SupportsCatalogs, SupportsSchemas: Boolean;
275  var Catalog, Schema, ObjectName: string); overload;
276 
277 {**
278  Assigns a Statement value from a TParam
279  @param Index the index of Statement.SetParam(Idex..);
280  @param Statement the PrepredStatement where the values have been assigned
281  @param Param the TParam where the value is assigned from
282 }
283 procedure SetStatementParam(Index: Integer;
284  Statement: IZPreparedStatement; Param: TParam);
285 
286 {** Common variables. }
287 var
288  CommonTokenizer: IZTokenizer;
289 
290 implementation
291 
292 uses
293  ZMessages, ZGenericSqlToken, ZDbcResultSetMetadata, ZAbstractRODataset,
294  ZDbcUtils
295  {$IFNDEF WITHOUT_VARBYTESASSTRING}, ZSysUtils{$ENDIF}
296  {$IFDEF WITH_INLINE_ANSISTRLCOMP}, Windows{$ENDIF};
297 
298 {**
299  Converts DBC Field Type to TDataset Field Type.
300  @param Value an initial DBC field type.
301  @return a converted TDataset field type.
302 }
303 function ConvertDbcToDatasetType(Value: TZSQLType): TFieldType;
304 begin
305  case Value of
306  stBoolean:
307  Result := ftBoolean;
308  stByte, stShort:
309  Result := ftSmallInt;
310  stInteger:
311  Result := ftInteger;
312  stLong:
313  Result := ftLargeInt;
314  stFloat, stDouble, stBigDecimal:
315  Result := ftFloat;
316  stString:
317  Result := ftString;
318  stBytes{$IFNDEF WITH_FTGUID}, stGUID{$ENDIF}:
319  Result := ftBytes;
320  {$IFDEF WITH_FTGUID}
321  stGUID:
322  Result := ftGUID;
323  {$ENDIF}
324  stDate:
325  Result := ftDate;
326  stTime:
327  Result := ftTime;
328  stTimestamp:
329  Result := ftDateTime;
330  stAsciiStream:
331  Result := ftMemo;
332  stBinaryStream:
333  Result := ftBlob;
334  stUnicodeString:
335  Result := ftWideString;
336  stUnicodeStream:
337  Result := {$IFNDEF WITH_WIDEMEMO}ftWideString{$ELSE}ftWideMemo{$ENDIF};
338  {$IFDEF WITH_FTDATASETSUPPORT}
339  stDataSet:
340  Result := ftDataSet;
341  {$ENDIF}
342  else
343  Result := ftUnknown;
344  end;
345 end;
346 
347 {**
348  Converts TDataset Field Type to DBC Field Type.
349  @param Value an initial TDataset field type.
350  @return a converted DBC field type.
351 }
352 function ConvertDatasetToDbcType(Value: TFieldType): TZSQLType;
353 begin
354  case Value of
355  ftBoolean:
356  Result := stBoolean;
357  ftSmallInt:
358  Result := stShort;
359  ftInteger, ftAutoInc:
360  Result := stInteger;
361  ftFloat:
362  Result := stDouble;
363  ftLargeInt:
364  Result := stLong;
365  ftCurrency:
366  Result := stBigDecimal;
367  ftString:
368  Result := stString;
369  ftBytes:
370  Result := stBytes;
371  ftDate:
372  Result := stDate;
373  ftTime:
374  Result := stTime;
375  ftDateTime:
376  Result := stTimestamp;
377  ftMemo:
378  Result := stAsciiStream;
379  ftBlob:
380  Result := stBinaryStream;
381  ftWideString:
382  Result := stUnicodeString;
383  {$IFDEF WITH_FTGUID}
384  ftGuid:
385  Result := stGUID;
386  {$ENDIF}
387  {$IFDEF WITH_WIDEMEMO}
388  ftWideMemo:
389  Result := stUnicodeStream;
390  {$ENDIF}
391  {$IFDEF WITH_FTDATASETSUPPORT}
392  ftDataSet:
393  Result := stDataSet;
394  {$ENDIF}
395  else
396  Result := stUnknown;
397  end;
398 end;
399 
400 {**
401  Converts field definitions into column information objects.
402  @param Fields a collection of field definitions.
403  @return a collection of column information objects.
404 }
405 function ConvertFieldsToColumnInfo(Fields: TFields): TObjectList;
406 var
407  I: Integer;
408  Current: TField;
409  ColumnInfo: TZColumnInfo;
410 begin
411  Result := TObjectList.Create(True);
412  for I := 0 to Fields.Count - 1 do
413  begin
414  Current := Fields[I];
415  ColumnInfo := TZColumnInfo.Create;
416 
417  ColumnInfo.ColumnType := ConvertDatasetToDbcType(Current.DataType);
418  ColumnInfo.ColumnName := Current.FieldName;
419  ColumnInfo.Precision := Current.Size;
420 //This is a hack for stUnicodeStream because there is only ftWideString for both type
421  if ColumnInfo.ColumnType = stUnicodeString then
422  if Current.Size > 10240 then
423  ColumnInfo.ColumnType := stUnicodeStream;
424  ColumnInfo.Scale := 0;
425  ColumnInfo.ColumnLabel := Current.DisplayName;
426  ColumnInfo.ColumnDisplaySize := Current.DisplayWidth;
427  ColumnInfo.DefaultExpression := Current.DefaultExpression;
428 
429  Result.Add(ColumnInfo);
430  end;
431 end;
432 
433 {**
434  Fetches columns from specified resultset.
435  @param ResultSet a source resultset.
436  @param FieldsLookupTable a lookup table to define original index.
437  @param Fields a collection of field definitions.
438  @param RowAccessor a destination row accessor.
439 }
440 procedure FetchFromResultSet(ResultSet: IZResultSet;
441  const FieldsLookupTable: TIntegerDynArray; Fields: TFields;
442  RowAccessor: TZRowAccessor);
443 var
444  I, FieldIndex: Integer;
445  Current: TField;
446  ColumnIndex, ColumnCount: Integer;
447 begin
448  RowAccessor.RowBuffer.Index := ResultSet.GetRow;
449  ColumnCount := ResultSet.GetMetadata.GetColumnCount;
450 
451  for I := 0 to Fields.Count - 1 do
452  begin
453  Current := Fields[I];
454  if not (Current.FieldKind in [fkData, fkInternalCalc]) then
455  Continue;
456 
457  ColumnIndex := Current.FieldNo;
458  FieldIndex := DefineFieldIndex(FieldsLookupTable, Current);
459  if (ColumnIndex < 1) or (ColumnIndex > ColumnCount) then
460  Continue;
461 
462  case Current.DataType of
463  ftBoolean:
464  RowAccessor.SetBoolean(FieldIndex, ResultSet.GetBoolean(ColumnIndex));
465  ftSmallInt:
466  RowAccessor.SetShort(FieldIndex, ResultSet.GetShort(ColumnIndex));
467  ftInteger, ftAutoInc:
468  RowAccessor.SetInt(FieldIndex, ResultSet.GetInt(ColumnIndex));
469  ftFloat:
470  RowAccessor.SetDouble(FieldIndex, ResultSet.GetDouble(ColumnIndex));
471  ftLargeInt:
472  RowAccessor.SetLong(FieldIndex, ResultSet.GetLong(ColumnIndex));
473  ftCurrency:
474  RowAccessor.SetBigDecimal(FieldIndex, ResultSet.GetBigDecimal(ColumnIndex));
475  ftString:
476  // gto: do we need PChar here?
477  //RowAccessor.SetPChar(FieldIndex, ResultSet.GetPChar(ColumnIndex));
478  RowAccessor.SetString(FieldIndex, ResultSet.GetString(ColumnIndex));
479  ftWidestring:
480  RowAccessor.SetUnicodeString(FieldIndex, ResultSet.GetUnicodeString(ColumnIndex));
481  ftBytes{$IFDEF WITH_FTGUID}, ftGuid{$ENDIF}:
482  RowAccessor.SetBytes(FieldIndex, ResultSet.GetBytes(ColumnIndex));
483  ftDate:
484  RowAccessor.SetDate(FieldIndex, ResultSet.GetDate(ColumnIndex));
485  ftTime:
486  RowAccessor.SetTime(FieldIndex, ResultSet.GetTime(ColumnIndex));
487  ftDateTime:
488  RowAccessor.SetTimestamp(FieldIndex, ResultSet.GetTimestamp(ColumnIndex));
489  ftMemo, ftBlob {$IFDEF WITH_WIDEMEMO}, ftWideMemo{$ENDIF}:
490  RowAccessor.SetBlob(FieldIndex, ResultSet.GetBlob(ColumnIndex));
491  {$IFDEF WITH_FTDATASETSUPPORT}
492  ftDataSet:
493  RowAccessor.SetDataSet(FieldIndex, ResultSet.GetDataSet(ColumnIndex));
494  {$ENDIF}
495  end;
496 
497  if ResultSet.WasNull then
498  RowAccessor.SetNull(FieldIndex);
499  end;
500 end;
501 
502 {**
503  Posts columns from specified resultset.
504  @param ResultSet a source resultset.
505  @param FieldsLookupTable a lookup table to define original index.
506  @param Fields a collection of field definitions.
507  @param RowAccessor a destination row accessor.
508 }
509 procedure PostToResultSet(ResultSet: IZResultSet;
510  const FieldsLookupTable: TIntegerDynArray; Fields: TFields;
511  RowAccessor: TZRowAccessor);
512 var
513  I, FieldIndex: Integer;
514  Current: TField;
515  WasNull: Boolean;
516  ColumnIndex, ColumnCount: Integer;
517  Stream: TStream;
518 begin
519  WasNull := False;
520  RowAccessor.RowBuffer.Index := ResultSet.GetRow;
521  ColumnCount := ResultSet.GetMetadata.GetColumnCount;
522 
523  for I := 0 to Fields.Count - 1 do
524  begin
525  Current := Fields[I];
526  if Current.FieldKind <> fkData then
527  Continue;
528 
529  ColumnIndex := Current.FieldNo;
530  FieldIndex := DefineFieldIndex(FieldsLookupTable, Current);
531  if (ColumnIndex < 1) or (ColumnIndex > ColumnCount) then
532  Continue;
533 
534 // if (Current.Required = True) and (WasNull = True) then
535 // raise EZDatabaseError.Create(Format(SFieldCanNotBeNull, [Current.FieldName]));
536  case Current.DataType of
537  ftBoolean:
538  ResultSet.UpdateBoolean(ColumnIndex, RowAccessor.GetBoolean(FieldIndex, WasNull));
539  ftSmallInt:
540  ResultSet.UpdateShort(ColumnIndex, RowAccessor.GetShort(FieldIndex, WasNull));
541  ftInteger, ftAutoInc:
542  ResultSet.UpdateInt(ColumnIndex, RowAccessor.GetInt(FieldIndex, WasNull));
543  ftFloat:
544  ResultSet.UpdateDouble(ColumnIndex, RowAccessor.GetDouble(FieldIndex, WasNull));
545  ftLargeInt:
546  ResultSet.UpdateLong(ColumnIndex, RowAccessor.GetLong(FieldIndex, WasNull));
547  ftCurrency:
548  ResultSet.UpdateBigDecimal(ColumnIndex,
549  RowAccessor.GetBigDecimal(FieldIndex, WasNull));
550  ftString:
551  ResultSet.UpdateString(ColumnIndex, RowAccessor.GetString(FieldIndex, WasNull));
552  ftWidestring:
553  ResultSet.UpdateUnicodeString(ColumnIndex,
554  RowAccessor.GetUnicodeString(FieldIndex, WasNull));
555  ftBytes{$IFDEF WITH_FTGUID}, ftGuid{$ENDIF}:
556  ResultSet.UpdateBytes(ColumnIndex, RowAccessor.GetBytes(FieldIndex, WasNull));
557  ftDate:
558  ResultSet.UpdateDate(ColumnIndex, RowAccessor.GetDate(FieldIndex, WasNull));
559  ftTime:
560  ResultSet.UpdateTime(ColumnIndex, RowAccessor.GetTime(FieldIndex, WasNull));
561  ftDateTime:
562  ResultSet.UpdateTimestamp(ColumnIndex,
563  RowAccessor.GetTimestamp(FieldIndex, WasNull));
564  ftMemo:
565  begin
566  Stream := RowAccessor.GetAsciiStream(FieldIndex, WasNull);
567  try
568  ResultSet.UpdateAsciiStream(ColumnIndex, Stream);
569  finally
570  Stream.Free;
571  end;
572  end;
573  {$IFDEF WITH_WIDEMEMO}
574  ftWideMemo:
575  begin
576  Stream := RowAccessor.GetUnicodeStream(FieldIndex, WasNull);
577  try
578  ResultSet.UpdateUnicodeStream(ColumnIndex, Stream);
579  finally
580  Stream.Free;
581  end;
582  end;
583  {$ENDIF}
584  ftBlob:
585  begin
586  Stream := RowAccessor.GetBinaryStream(FieldIndex, WasNull);
587  try
588  ResultSet.UpdateBinaryStream(ColumnIndex, Stream);
589  finally
590  Stream.Free;
591  end;
592  end;
593  {$IFDEF WITH_FTDATASETSUPPORT}
594  ftDataSet:
595  ResultSet.UpdateDataSet(ColumnIndex, RowAccessor.GetDataSet(FieldIndex, WasNull));
596  {$ENDIF}
597  end;
598 
599  if WasNull then
600  begin
601  // Performance thing :
602  // The default expression will only be set when necessary : if the value really IS null
603  Resultset.UpdateDefaultExpression(ColumnIndex, RowAccessor.GetColumnDefaultExpression(FieldIndex));
604  ResultSet.UpdateNull(ColumnIndex);
605  end;
606  end;
607 end;
608 
609 {**
610  Defines fields indices for the specified dataset.
611  @param DataSet a dataset object.
612  @param FieldNames a list of field names.
613  @param OnlyDataFields <code>True</code> if only data fields selected.
614 }
615 function DefineFields(DataSet: TDataset; const FieldNames: string;
616  var OnlyDataFields: Boolean): TObjectDynArray;
617 var
618  I: Integer;
619  Tokens: TStrings;
620  TokenType: TZTokenType;
621  TokenValue: string;
622  Field: TField;
623  FieldCount: Integer;
624 begin
625  OnlyDataFields := True;
626  FieldCount := 0;
627  SetLength(Result, FieldCount);
628  Tokens := CommonTokenizer.TokenizeBufferToList(FieldNames,
629  [toSkipEOF, toSkipWhitespaces, toUnifyNumbers, toDecodeStrings]);
630 
631  try
632  for I := 0 to Tokens.Count - 1 do
633  begin
634  TokenType := TZTokenType({$IFDEF oldFPC}Pointer({$ENDIF}
635  Tokens.Objects[I]{$IFDEF oldFPC}){$ENDIF});
636  TokenValue := Tokens[I];
637  Field := nil;
638 
639  if TokenType in [ttWord, ttQuoted] then
640  begin
641  Field := DataSet.FieldByName(TokenValue);
642  end
643  else if (TokenType = ttNumber)
644  and (StrToIntDef(TokenValue, 0) < Dataset.Fields.Count) then
645  begin
646  Field := Dataset.Fields[StrToIntDef(TokenValue, 0)];
647  end
648  else if (TokenValue <> ',') and (TokenValue <> ';') then
649  begin
650  raise EZDatabaseError.Create(Format(SIncorrectSymbol, [TokenValue]));
651  end;
652 
653  if Field <> nil then
654  begin
655  OnlyDataFields := OnlyDataFields and (Field.FieldKind = fkData);
656  Inc(FieldCount);
657  SetLength(Result, FieldCount);
658  Result[FieldCount - 1] := Field;
659  end;
660  end;
661  finally
662  Tokens.Free;
663  end;
664 
665  if Length(Result) = 0 then
666  Result := nil;
667 end;
668 
669 {**
670  Defins a indices of filter fields.
671  @param Dataset a dataset object.
672  @param Expression a expression calculator.
673  @returns an array with field object references.
674 }
675 function DefineFilterFields(DataSet: TDataset;
676  Expression: IZExpression): TObjectDynArray;
677 var
678  I: Integer;
679  Current: TField;
680 begin
681  if Expression.Expression <> '' then
682  begin
683  SetLength(Result, Expression.DefaultVariables.Count);
684  for I := 0 to Expression.DefaultVariables.Count - 1 do
685  begin
686  Current := DataSet.FindField(Expression.DefaultVariables.Names[I]);
687  if Current <> nil then
688  Result[I] := Current
689  else
690  Result[I] := nil;
691  end;
692  end
693  else
694  SetLength(Result, 0);
695 end;
696 
697 {**
698  Retrieves a set of specified field values.
699  @param FieldRefs an array with interested field object references.
700  @param ResultSet an initial result set object.
701  @param ResultValues a container for result values.
702  @return an array with field values.
703 }
704 procedure RetrieveDataFieldsFromResultSet(const FieldRefs: TObjectDynArray;
705  ResultSet: IZResultSet; var ResultValues: TZVariantDynArray);
706 var
707  I, ColumnIndex: Integer;
708 begin
709  for I := 0 to High(FieldRefs) do
710  begin
711  ColumnIndex := TField(FieldRefs[I]).FieldNo;
712  if ColumnIndex >= 0 then
713  begin
714  case TField(FieldRefs[I]).DataType of
715  ftString:
716  DefVarManager.SetAsString(ResultValues[I],
717  ResultSet.GetString(ColumnIndex));
718  ftBoolean:
719  DefVarManager.SetAsBoolean(ResultValues[I],
720  ResultSet.GetBoolean(ColumnIndex));
721  ftSmallInt, ftInteger, ftAutoInc:
722  DefVarManager.SetAsInteger(ResultValues[I],
723  ResultSet.GetInt(ColumnIndex));
724  ftFloat:
725  DefVarManager.SetAsFloat(ResultValues[I],
726  ResultSet.GetDouble(ColumnIndex));
727  ftLargeInt:
728  DefVarManager.SetAsInteger(ResultValues[I],
729  ResultSet.GetLong(ColumnIndex));
730  ftCurrency:
731  DefVarManager.SetAsFloat(ResultValues[I],
732  ResultSet.GetBigDecimal(ColumnIndex));
733  ftDate, ftTime, ftDateTime:
734  DefVarManager.SetAsDateTime(ResultValues[I],
735  ResultSet.GetTimestamp(ColumnIndex));
736  ftWidestring:
737  DefVarManager.SetAsUnicodeString(ResultValues[I],
738  ResultSet.GetUnicodeString(ColumnIndex));
739  else
740  DefVarManager.SetAsString(ResultValues[I],
741  ResultSet.GetString(ColumnIndex));
742  end;
743  if ResultSet.WasNull then
744  ResultValues[I] := NullVariant;
745  end
746  else
747  ResultValues[I] := NullVariant;
748  end;
749 end;
750 
751 {**
752  Retrieves a set of specified field values.
753  @param FieldRefs an array with interested field object references.
754  @param FieldIndices an array with interested field indices.
755  @param RowAccessor a row accessor object.
756  @param ResultValues a container for result values.
757  @return an array with field values.
758 }
759 procedure RetrieveDataFieldsFromRowAccessor(const FieldRefs: TObjectDynArray;
760  const FieldIndices: TIntegerDynArray; RowAccessor: TZRowAccessor;
761  var ResultValues: TZVariantDynArray);
762 var
763  I: Integer;
764  ColumnIndex: Integer;
765  WasNull: Boolean;
766 begin
767  WasNull := False;
768  for I := 0 to High(FieldRefs) do
769  begin
770  ColumnIndex := FieldIndices[I];
771  case TField(FieldRefs[I]).DataType of
772  ftString:
773  DefVarManager.SetAsString(ResultValues[I],
774  RowAccessor.GetString(ColumnIndex, WasNull));
775  ftBoolean:
776  DefVarManager.SetAsBoolean(ResultValues[I],
777  RowAccessor.GetBoolean(ColumnIndex, WasNull));
778  ftSmallInt, ftInteger, ftAutoInc:
779  DefVarManager.SetAsInteger(ResultValues[I],
780  RowAccessor.GetInt(ColumnIndex, WasNull));
781  ftFloat:
782  DefVarManager.SetAsFloat(ResultValues[I],
783  RowAccessor.GetDouble(ColumnIndex, WasNull));
784  ftLargeInt:
785  DefVarManager.SetAsInteger(ResultValues[I],
786  RowAccessor.GetLong(ColumnIndex, WasNull));
787  ftCurrency:
788  DefVarManager.SetAsFloat(ResultValues[I],
789  RowAccessor.GetBigDecimal(ColumnIndex, WasNull));
790  ftDate, ftTime, ftDateTime:
791  DefVarManager.SetAsDateTime(ResultValues[I],
792  RowAccessor.GetTimestamp(ColumnIndex, WasNull));
793  ftWidestring:
794  DefVarManager.SetAsUnicodeString(ResultValues[I],
795  RowAccessor.GetUnicodeString(ColumnIndex, WasNull));
796  else
797  DefVarManager.SetAsString(ResultValues[I],
798  RowAccessor.GetString(ColumnIndex, WasNull));
799  end;
800  if WasNull then
801  ResultValues[I] := NullVariant;
802  end;
803 end;
804 
805 {**
806  Copy a set of specified field values to variables.
807  @param Fields an array with interested field object references.
808  @param ResultSet an initial result set object.
809  @param Variables a list of variables.
810 }
811 {$IFDEF FPC}
812  {$HINTS OFF} //Temp seems not to be init...
813 {$ENDIF}
814 procedure CopyDataFieldsToVars(const Fields: TObjectDynArray;
815  ResultSet: IZResultSet; Variables: IZVariablesList);
816 var
817  I, ColumnIndex: Integer;
818  Temp: TZVariant;
819 begin
820  for I := 0 to Length(Fields) - 1 do
821  begin
822  if Fields[I] = nil then
823  Continue;
824 
825  ColumnIndex := TField(Fields[I]).FieldNo;
826  if not ResultSet.IsNull(ColumnIndex) then
827  begin
828  case TField(Fields[I]).DataType of
829  ftBoolean:
830  DefVarManager.SetAsBoolean(Temp, ResultSet.GetBoolean(ColumnIndex));
831  ftSmallInt, ftInteger, ftAutoInc:
832  DefVarManager.SetAsInteger(Temp, ResultSet.GetInt(ColumnIndex));
833  ftFloat:
834  DefVarManager.SetAsFloat(Temp, ResultSet.GetDouble(ColumnIndex));
835  ftLargeInt:
836  DefVarManager.SetAsInteger(Temp, ResultSet.GetLong(ColumnIndex));
837  ftCurrency:
838  DefVarManager.SetAsFloat(Temp, ResultSet.GetBigDecimal(ColumnIndex));
839  ftDate:
840  DefVarManager.SetAsDateTime(Temp, ResultSet.GetDate(ColumnIndex));
841  ftTime:
842  DefVarManager.SetAsDateTime(Temp, ResultSet.GetTime(ColumnIndex));
843  ftDateTime:
844  DefVarManager.SetAsDateTime(Temp, ResultSet.GetTimestamp(ColumnIndex));
845  ftWidestring:
846  DefVarManager.SetAsUnicodeString(Temp,
847  ResultSet.GetUnicodeString(ColumnIndex));
848  else
849  DefVarManager.SetAsString(Temp, ResultSet.GetString(ColumnIndex));
850  end;
851  Variables.Values[I] := Temp;
852  end
853  else
854  begin
855  DefVarManager.SetNull(Temp);
856  Variables.Values[I] := Temp;
857  end;
858  end;
859 end;
860 {$IFDEF FPC}
861  {$HINTS OFF}
862 {$ENDIF}
863 
864 {**
865  Compares row field values with the given ones.
866  @param KeyValues given values.
867  @param RowValues row field values.
868  @param PartialKey <code>True</code> if values should be started with the keys.
869  @param CaseInsensitive <code>True</code> if keys are case insensitive.
870  @return <code> if values are equal.
871 }
872 function CompareDataFields(const KeyValues, RowValues: TZVariantDynArray;
873  PartialKey: Boolean; CaseInsensitive: Boolean): Boolean;
874 var
875  I: Integer;
876  Value1, Value2: AnsiString;
877  WValue1, WValue2: WideString;
878 begin
879  Result := True;
880  for I := 0 to High(KeyValues) do
881  begin
882  case KeyValues[I].VType of
883  vtUnicodeString:
884  begin
885  if CaseInsensitive then
886  begin
887  WValue1 := WideUpperCase(SoftVarManager.GetAsUnicodeString(KeyValues[I]));
888  WValue2 := WideUpperCase(SoftVarManager.GetAsUnicodeString(RowValues[I]));
889  if PartialKey then
890  begin
891  {$IFDEF UNICODE}
892  Result := SysUtils.AnsiStrLComp(PWideChar(WValue2), PWideChar(WValue1), Length(WValue1)) = 0;
893  {$ELSE}
894  Value1 := AnsiString(WValue1);
895  Value2 := AnsiString(WValue2);
896  Result := AnsiStrLComp(PAnsiChar(Value2), PAnsiChar(Value1), Length(Value1)) = 0;
897  {$ENDIF}
898  end
899  else
900  Result := WValue1 = WValue2
901  end
902  else
903  begin
904  WValue1 := SoftVarManager.GetAsUnicodeString(KeyValues[I]);
905  WValue1 := SoftVarManager.GetAsUnicodeString(RowValues[I]);
906  if PartialKey then
907  begin
908  {$IFDEF UNICODE}
909  Result := SysUtils.AnsiStrLComp(PWideChar(WValue2), PWideChar(WValue1), Length(WValue1)) = 0;
910  {$ELSE}
911  Value1 := AnsiString(WValue1);
912  Value2 := AnsiString(WValue2);
913  Result := AnsiStrLComp(PAnsiChar(Value2), PAnsiChar(Value1), Length(Value1)) = 0;
914  {$ENDIF}
915  end
916  else
917  Result := SoftVarManager.Compare(KeyValues[I], RowValues[I]) = 0;
918  end;
919  end;
920  else
921  begin
922  if CaseInsensitive then
923  begin
924  Value1 := AnsiString(AnsiUpperCase(SoftVarManager.GetAsString(KeyValues[I])));
925  Value2 := AnsiString(AnsiUpperCase(SoftVarManager.GetAsString(RowValues[I])));
926  if PartialKey then
927 
928  Result := {$IFDEF WITH_ANSISTRLCOMP_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrLComp(PAnsiChar(Value2), PAnsiChar(Value1), Length(Value1)) = 0
929  else
930  Result := Value1 = Value2
931  end
932  else
933  begin
934  Value1 := AnsiString(SoftVarManager.GetAsString(KeyValues[I]));
935  Value2 := AnsiString(SoftVarManager.GetAsString(RowValues[I]));
936  if PartialKey then
937  Result := {$IFDEF WITH_ANSISTRLCOMP_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrLComp(PAnsiChar(Value2), PAnsiChar(Value1), Length(Value1)) = 0
938  else
939  Result := SoftVarManager.Compare(KeyValues[I], RowValues[I]) = 0;
940  end;
941  end;
942  end;
943 
944  if not Result then
945  Break;
946  end;
947 end;
948 
949 {**
950  Prepares values for comparison by CompareFieldsFromResultSet.
951  @param FieldRefs an array with interested field object references.
952  @param DecodedKeyValues given values.
953  @param ResultSet a resultset to get field values.
954  @param PartialKey <code>True</code> if values should be started with the keys.
955  @param CaseInsensitive <code>True</code> if keys are case insensitive.
956 }
957 procedure PrepareValuesForComparison(const FieldRefs: TObjectDynArray;
958  var DecodedKeyValues: TZVariantDynArray; ResultSet: IZResultSet;
959  PartialKey: Boolean; CaseInsensitive: Boolean);
960 var
961  I: Integer;
962  Current: TField;
963  CurrentType : TZSQLType;
964 begin
965  { Preprocesses cycle variables. }
966  for I := 0 to High(FieldRefs) do
967  begin
968  Current := TField(FieldRefs[I]);
969 
970  if DecodedKeyValues[I].VType = vtNull then
971  Continue;
972 
973  CurrentType := ResultSet.GetMetadata.GetColumnType(Current.FieldNo);
974 
975  if PartialKey then
976  begin
977  if CurrentType = stUnicodeString then
978  begin
979  DecodedKeyValues[I] := SoftVarManager.Convert(
980  DecodedKeyValues[I], vtUnicodeString);
981  if CaseInsensitive then
982  begin
983  if DecodedKeyValues[I].VType = vtString then
984  begin
985  DecodedKeyValues[I].VString := Uppercase(DecodedKeyValues[I].VString);
986  DecodedKeyValues[I].VUnicodeString := DecodedKeyValues[I].VString;
987  end
988  else
989  begin
990  DecodedKeyValues[I].VUnicodeString :=
991  WideUpperCase(DecodedKeyValues[I].VUnicodeString);
992  end;
993  end;
994  end
995  else
996  begin
997  DecodedKeyValues[I] := SoftVarManager.Convert(
998  DecodedKeyValues[I], vtString);
999  if CaseInsensitive then
1000  begin
1001  {$IFDEF LAZARUSUTF8HACK} // Is this correct? Assumes the Lazarus convention all strings are UTF8. But is that
1002  // true in this point, or should that be converted higher up?
1003  DecodedKeyValues[I].VString :=
1004  WideUpperCase(UTF8Decode (DecodedKeyValues[I].VString));
1005  {$ELSE}
1006  DecodedKeyValues[I].VString :=
1007  AnsiUpperCase(DecodedKeyValues[I].VString);
1008  {$ENDIF}
1009  end;
1010  end;
1011  end
1012  else
1013  begin
1014  case CurrentType of
1015  stBoolean:
1016  DecodedKeyValues[I] := SoftVarManager.Convert(
1017  DecodedKeyValues[I], vtBoolean);
1018  stByte, stShort, stInteger, stLong:
1019  DecodedKeyValues[I] := SoftVarManager.Convert(
1020  DecodedKeyValues[I], vtInteger);
1021  stFloat, stDouble, stBigDecimal:
1022  DecodedKeyValues[I] := SoftVarManager.Convert(
1023  DecodedKeyValues[I], vtFloat);
1024  stUnicodeString:
1025  begin
1026  if CaseInsensitive then
1027  begin
1028  if DecodedKeyValues[I].VType = vtString then
1029  begin
1030  DecodedKeyValues[I].VString := Uppercase(DecodedKeyValues[I].VString);
1031  DecodedKeyValues[I].VUnicodeString := DecodedKeyValues[I].VString;
1032  end
1033  else
1034  begin
1035  DecodedKeyValues[I].VUnicodeString :=
1036  WideUpperCase(DecodedKeyValues[I].VUnicodeString);
1037  end;
1038  end
1039  else
1040  begin
1041  DecodedKeyValues[I] := SoftVarManager.Convert(
1042  DecodedKeyValues[I], vtUnicodeString);
1043  end;
1044  end;
1045  stDate, stTime, stTimestamp:
1046  DecodedKeyValues[I] := SoftVarManager.Convert(
1047  DecodedKeyValues[I], vtDateTime);
1048  else
1049  if CaseInsensitive then
1050  begin
1051  DecodedKeyValues[I] := SoftVarManager.Convert(
1052  DecodedKeyValues[I], vtString);
1053  {$IFDEF LAZARUSUTF8HACK}
1054  // Is this correct? Assumes the Lazarus convention all strings are UTF8. But is that
1055  // true in this point, or should that be converted higher up?
1056  DecodedKeyValues[I].VString :=
1057  WideUpperCase(UTF8Decode (DecodedKeyValues[I].VString));
1058  {$ELSE}
1059  DecodedKeyValues[I].VString :=
1060  AnsiUpperCase(DecodedKeyValues[I].VString);
1061  {$ENDIF}
1062  end
1063  else
1064  begin
1065  DecodedKeyValues[I] := SoftVarManager.Convert(
1066  DecodedKeyValues[I], vtString);
1067  end;
1068  end;
1069  end;
1070  end;
1071 end;
1072 
1073 {**
1074  Compares row field values with the given ones.
1075  @param FieldRefs an array with interested field object references.
1076  @param KeyValues given values.
1077  @param ResultSet a resultset to get field values.
1078  @param PartialKey <code>True</code> if values should be started with the keys.
1079  @param CaseInsensitive <code>True</code> if keys are case insensitive.
1080  @return <code> if values are equal.
1081 }
1082 function CompareFieldsFromResultSet(const FieldRefs: TObjectDynArray;
1083  const KeyValues: TZVariantDynArray; ResultSet: IZResultSet; PartialKey: Boolean;
1084  CaseInsensitive: Boolean): Boolean;
1085 var
1086  I: Integer;
1087  ColumnIndex: Integer;
1088  AValue1, AValue2: AnsiString;
1089  WValue1, WValue2: WideString;
1090  CurrentType : TZSQLType;
1091 begin
1092  Result := True;
1093  for I := 0 to High(KeyValues) do
1094  begin
1095  ColumnIndex := TField(FieldRefs[I]).FieldNo;
1096 
1097  if KeyValues[I].VType = vtNull then
1098  begin
1099  Result := ResultSet.IsNull(ColumnIndex);
1100  if not Result then
1101  Break;
1102  Continue;
1103  end;
1104 
1105  CurrentType := ResultSet.GetMetadata.GetColumnType(ColumnIndex);
1106 
1107  if PartialKey then
1108  begin
1109  if CurrentType = stUnicodeString then
1110  begin
1111  WValue1 := KeyValues[I].VUnicodeString;
1112  WValue2 := ResultSet.GetUnicodeString(ColumnIndex);
1113 
1114  if CaseInsensitive then
1115  WValue2 := WideUpperCase(WValue2);
1116  {$IFDEF UNICODE}
1117  Result := SysUtils.AnsiStrLComp(PWideChar(WValue2), PWideChar(WValue1), Length(WValue1)) = 0;
1118  {$ELSE}
1119  AValue1 := UTF8ToAnsi(UTF8Encode(WValue1));
1120  AValue2 := UTF8ToAnsi(UTF8Encode(WValue2));
1121  Result := AnsiStrLComp(PAnsiChar(AValue2), PAnsiChar(AValue1), Length(AValue1)) = 0;
1122  {$ENDIF}
1123  end
1124  else
1125  begin
1126  AValue1 := AnsiString(KeyValues[I].VString);
1127  if (ResultSet.GetConSettings.ClientCodePage^.Encoding = ceAnsi)
1128  or (ResultSet.GetConSettings.AutoEncode and ( ResultSet.GetConSettings.CTRL_CP <> 65001 )) then
1129  AValue2 := AnsiString(ResultSet.GetString(ColumnIndex))
1130  else
1131  AValue2 := AnsiString({$IFNDEF UNICODE}UTF8ToAnsi{$ENDIF}(ResultSet.GetString(ColumnIndex)));
1132 
1133  if CaseInsensitive then
1134  AValue2 := {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings.{$ENDIF}AnsiUpperCase(AValue2);
1135  Result := {$IFDEF WITH_ANSISTRLCOMP_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrLComp(PAnsiChar(AValue2), PAnsiChar(AValue1), Length(AValue1)) = 0;
1136  end;
1137 
1138  end
1139  else
1140  begin
1141  case CurrentType of
1142  stBoolean:
1143  begin
1144  Result := KeyValues[I].VBoolean =
1145  ResultSet.GetBoolean(ColumnIndex);
1146  end;
1147  stByte,
1148  stShort,
1149  stInteger,
1150  stLong:
1151  begin
1152  Result := KeyValues[I].VInteger =
1153  ResultSet.GetLong(ColumnIndex);
1154  end;
1155  stFloat:
1156  Result := Abs(KeyValues[I].VFloat -
1157  ResultSet.GetBigDecimal(ColumnIndex)) < FLOAT_COMPARE_PRECISION_SINGLE;
1158  stDouble,
1159  stBigDecimal:
1160  begin
1161  Result := Abs(KeyValues[I].VFloat -
1162  ResultSet.GetBigDecimal(ColumnIndex)) < FLOAT_COMPARE_PRECISION;
1163  end;
1164  stDate,
1165  stTime,
1166  stTimestamp:
1167  begin
1168  Result := KeyValues[I].VDateTime =
1169  ResultSet.GetTimestamp(ColumnIndex);
1170  end;
1171  stUnicodeString:
1172  begin
1173  if CaseInsensitive then
1174  begin
1175  Result := KeyValues[I].VUnicodeString =
1176  WideUpperCase(ResultSet.GetUnicodeString(ColumnIndex));
1177  end
1178  else
1179  begin
1180  Result := KeyValues[I].VUnicodeString =
1181  ResultSet.GetUnicodeString(ColumnIndex);
1182  end;
1183  end;
1184  else
1185  if CaseInsensitive then
1186  begin
1187  {$IFDEF LAZARUSUTF8HACK}
1188  Result := KeyValues[I].VString =
1189  AnsiUpperCase (Utf8ToAnsi(ResultSet.GetString(ColumnIndex)));
1190  {$ELSE}
1191  Result := KeyValues[I].VString =
1192  AnsiUpperCase(ResultSet.GetString(ColumnIndex));
1193  {$ENDIF}
1194  end
1195  else
1196  begin
1197  Result := KeyValues[I].VString =
1198  ResultSet.GetString(ColumnIndex);
1199  end;
1200  end;
1201  end;
1202 
1203  Result := Result and not ResultSet.WasNull;
1204  if not Result then
1205  Break;
1206  end;
1207 end;
1208 
1209 {**
1210  Defines a list of key field names.
1211  @param Fields a collection of dataset fields.
1212  @return a list of key field names.
1213 }
1214 function DefineKeyFields(Fields: TFields): string;
1215 var
1216  I: Integer;
1217  Temp: string;
1218 begin
1219  Result := '';
1220  for I := 0 to Fields.Count - 1 do
1221  begin
1222  if (Fields[I].FieldKind = fkData)
1223  and not (Fields[I].DataType in [ftBlob, ftMemo, ftBytes {$IFDEF WITH_WIDEMEMO}, ftWideMemo{$ENDIF}]) then
1224  begin
1225  if Result <> '' then
1226  Result := Result + ',';
1227  Temp := Fields[I].FieldName;
1228  if (Pos(' ', Temp) > 0) or (Pos('-', Temp) > 0) or (Pos('.', Temp) > 0) then
1229  Temp := '"' + Temp + '"';
1230  Result := Result + Temp;
1231  end;
1232  end;
1233 end;
1234 
1235 {**
1236  Converts datetime value into TDataset internal presentation.
1237  @param DataType a type of date-time field.
1238  @param Data a data which contains a value.
1239  @param Buffer a field buffer pointer
1240 }
1241 procedure DateTimeToNative(DataType: TFieldType; Data: TDateTime;
1242  Buffer: Pointer);
1243 var
1244  TimeStamp: TTimeStamp;
1245 begin
1246  TimeStamp := DateTimeToTimeStamp(Data);
1247  case DataType of
1248  ftDate: Integer(Buffer^) := TimeStamp.Date;
1249  ftTime: Integer(Buffer^) := TimeStamp.Time;
1250  else
1251  TDateTime(Buffer^) := TimeStampToMSecs(TimeStamp);
1252  end;
1253 end;
1254 
1255 {**
1256  Converts date times from TDataset internal presentation into datetime value.
1257  @param DataType a type of date-time field.
1258  @param Buffer a field buffer pointer
1259  @return a data which contains a value.
1260 }
1261 function NativeToDateTime(DataType: TFieldType; Buffer: Pointer): TDateTime;
1262 {$IFNDEF OLDFPC}
1263 var
1264  TimeStamp: TTimeStamp;
1265 begin
1266  case DataType of
1267  ftDate:
1268  begin
1269  TimeStamp.Time := 0;
1270  TimeStamp.Date := Integer(Buffer^);
1271  end;
1272  ftTime:
1273  begin
1274  {$IFDEF WITH_FPC_FTTIME_BUG}
1275  TimeStamp := DateTimeToTimeStamp(TDateTime(Buffer^));
1276  {$ELSE}
1277  TimeStamp.Time := Integer(Buffer^);
1278  TimeStamp.Date := DateDelta;
1279  {$ENDIF}
1280  end;
1281  else
1282  try
1283  {$IF not defined(cpui386) and defined(FPC)}
1284  TimeStamp := MSecsToTimeStamp(System.Trunc(Int(TDateTime(Buffer^))));
1285  {$ELSE}
1286  TimeStamp := MSecsToTimeStamp(TDateTime(Buffer^));
1287  {$IFEND}
1288  except
1289  TimeStamp.Time := 0;
1290  TimeStamp.Date := 0;
1291  end;
1292  end;
1293  Result := TimeStampToDateTime(TimeStamp);
1294 {$ELSE}
1295 begin
1296  Result := TDateTime(Buffer^);
1297 {$ENDIF}
1298 end;
1299 
1300 {**
1301  Compare values from two key fields.
1302  @param Field1 the first field object.
1303  @param ResultSet the resultset to read the first field value.
1304  @param Field2 the second field object.
1305 }
1306 function CompareKeyFields(Field1: TField; ResultSet: IZResultSet;
1307  Field2: TField): Boolean;
1308 begin
1309  Result := False;
1310  if Field1.FieldNo >= 1 then
1311  begin
1312  case Field1.DataType of
1313  ftBoolean:
1314  Result := ResultSet.GetBoolean(Field1.FieldNo) = Field2.AsBoolean;
1315  ftSmallInt, ftInteger, ftAutoInc:
1316  Result := ResultSet.GetInt(Field1.FieldNo) = Field2.AsInteger;
1317  ftFloat:
1318  begin
1319  Result := Abs(ResultSet.GetFloat(Field1.FieldNo)
1320  - Field2.AsFloat) < FLOAT_COMPARE_PRECISION;
1321  end;
1322  ftLargeInt:
1323  begin
1324  if Field2 is TLargeIntField then
1325  Result := ResultSet.GetLong(Field1.FieldNo)
1326  = TLargeIntField(Field2).AsLargeInt
1327  else
1328  Result := ResultSet.GetInt(Field1.FieldNo) = Field2.AsInteger;
1329  end;
1330  ftCurrency:
1331  begin
1332  Result := Abs(ResultSet.GetBigDecimal(Field1.FieldNo)
1333  - Field2.{$IFDEF WITH_ASCURRENCY}AsCurrency{$ELSE}AsFloat{$ENDIF})
1334  < FLOAT_COMPARE_PRECISION;
1335  end;
1336  ftDate:
1337  Result := ResultSet.GetDate(Field1.FieldNo) = Field2.AsDateTime;
1338  ftTime:
1339  Result := ResultSet.GetTime(Field1.FieldNo) = Field2.AsDateTime;
1340  ftDateTime:
1341  Result := ResultSet.GetTimestamp(Field1.FieldNo) = Field2.AsDateTime;
1342  ftWideString:
1343  Result := ResultSet.GetUnicodeString(Field1.FieldNo) =
1344  Field2.{$IFDEF WITH_ASVARIANT}AsVariant{$ELSE}AsString{$ENDIF};
1345  else
1346  Result := ResultSet.GetString(Field1.FieldNo) = Field2.AsString;
1347  end;
1348  end;
1349 end;
1350 
1351 {**
1352  Defins a indices and directions for sorted fields.
1353  @param Dataset a dataset object.
1354  @param SortedFields an encoded fields for sorting in the format
1355  <Field Name> [ASC | DESC] [, ...]
1356  @param FieldRefs a decoded field object references.
1357  @param FieldDirs a decoded field directions.
1358  @param OnlyDataFields <code>True</code> if only data fields selected.
1359 }
1360 procedure DefineSortedFields(DataSet: TDataset;
1361  const SortedFields: string; var FieldRefs: TObjectDynArray;
1362  var FieldDirs: TBooleanDynArray; var OnlyDataFields: Boolean);
1363 var
1364  I: Integer;
1365  Tokens: TStrings;
1366  TokenType: TZTokenType;
1367  TokenValue: string;
1368  Field: TField;
1369  FieldCount: Integer;
1370 begin
1371  OnlyDataFields := True;
1372  FieldCount := 0;
1373  SetLength(FieldRefs, FieldCount);
1374  SetLength(FieldDirs, FieldCount);
1375  Tokens := CommonTokenizer.TokenizeBufferToList(SortedFields,
1376  [toSkipEOF, toSkipWhitespaces, toUnifyNumbers, toDecodeStrings]);
1377 
1378  try
1379  for I := 0 to Tokens.Count - 1 do
1380  begin
1381  TokenType := TZTokenType({$IFDEF OLDFPC}Pointer({$ENDIF}
1382  Tokens.Objects[I]{$IFDEF OLDFPC}){$ENDIF});
1383  TokenValue := Tokens[I];
1384  Field := nil;
1385 
1386  if ((UpperCase(TokenValue) = 'DESC')
1387  or (UpperCase(TokenValue) = 'ASC')) and (FieldCount > 0) then
1388  begin
1389  FieldDirs[FieldCount - 1] := (UpperCase(TokenValue) <> 'DESC');
1390  end
1391  else if TokenType in [ttWord, ttQuoted] then
1392  begin
1393  Field := DataSet.FieldByName(TokenValue)
1394  end
1395  else if (TokenType = ttNumber)
1396  and (StrToIntDef(TokenValue, 0) < Dataset.Fields.Count) then
1397  begin
1398  Field := Dataset.Fields[StrToIntDef(TokenValue, 0)];
1399  end
1400  else if (TokenValue <> ',') and (TokenValue <> ';') then
1401  begin
1402  raise EZDatabaseError.Create(Format(SIncorrectSymbol, [TokenValue]));
1403  end;
1404 
1405  if Field <> nil then
1406  begin
1407  OnlyDataFields := OnlyDataFields and (Field.FieldKind = fkData);
1408  Inc(FieldCount);
1409  SetLength(FieldRefs, FieldCount);
1410  SetLength(FieldDirs, FieldCount);
1411  FieldRefs[FieldCount - 1] := Field;
1412  FieldDirs[FieldCount - 1] := True;
1413  end;
1414  end;
1415  finally
1416  Tokens.Free;
1417  end;
1418 end;
1419 
1420 {**
1421  Creates a fields lookup table to define fixed position
1422  of the field in dataset.
1423  @param Fields a collection of TDataset fields in initial order.
1424  @returns a fields lookup table.
1425 }
1426 function CreateFieldsLookupTable(Fields: TFields): TIntegerDynArray;
1427 var
1428  I: Integer;
1429 begin
1430  SetLength(Result, Fields.Count);
1431  for I := 0 to Fields.Count - 1 do
1432  Result[I] := Integer(Fields[I]);
1433 end;
1434 
1435 {**
1436  Defines an original field index in the dataset.
1437  @param FieldsLookupTable a lookup table to define original index.
1438  @param Field a TDataset field object.
1439  @returns an original fields index or -1 otherwise.
1440 }
1441 function DefineFieldIndex(const FieldsLookupTable: TIntegerDynArray;
1442  Field: TField): Integer;
1443 var
1444  I: Integer;
1445 begin
1446  Result := -1;
1447  for I := 0 to High(FieldsLookupTable) do
1448  begin
1449  if FieldsLookupTable[I] = Integer(Field) then
1450  begin
1451  Result := I + 1;
1452  Break;
1453  end;
1454  end;
1455 end;
1456 
1457 {**
1458  Defines an original field indices in the dataset.
1459  @param FieldsLookupTable a lookup table to define original index.
1460  @param FieldRefs a TDataset field object references.
1461  @returns an array with original fields indices.
1462 }
1463 function DefineFieldIndices(const FieldsLookupTable: TIntegerDynArray;
1464  const FieldRefs: TObjectDynArray): TIntegerDynArray;
1465 var
1466  I: Integer;
1467 begin
1468  if FieldRefs = nil then
1469  begin
1470  Result := nil;
1471  Exit;
1472  end;
1473 
1474  SetLength(Result, Length(FieldRefs));
1475  for I := 0 to High(Result) do
1476  Result[I] := DefineFieldIndex(FieldsLookupTable, TField(FieldRefs[I]));
1477 end;
1478 
1479 {**
1480  Splits up a qualified object name into pieces. Catalog, schema
1481  and objectname.
1482 }
1483 procedure SplitQualifiedObjectName(QualifiedName: string;
1484  var Catalog, Schema, ObjectName: string);
1485 
1486 {$IFDEF OLDFPC}
1487 function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar;
1488  Strings: TStrings): Integer;
1489 var
1490  Head, Tail: PChar;
1491  EOS, InQuote: Boolean;
1492  QuoteChar: Char;
1493  Item: string;
1494 begin
1495  Result := 0;
1496  if (Content = nil) or (Content^ = #0) or (Strings = nil) then
1497  Exit;
1498  Tail := Content;
1499  InQuote := False;
1500  QuoteChar := #0;
1501  Strings.BeginUpdate;
1502  try
1503  repeat
1504  while CharInSet(Tail^, WhiteSpace + [#13, #10]) do
1505  Inc(Tail);
1506  Head := Tail;
1507  while True do
1508  begin
1509  while (InQuote and not CharInSet(Tail^, [QuoteChar, #0])) or
1510  not CharInSet(Tail^, Separators + [#0, #13, #10, '''', '"']) do
1511  Inc(Tail);
1512  if CharInSet(Tail^, ['''', '"']) then
1513  begin
1514  if (QuoteChar <> #0) and (QuoteChar = Tail^) then
1515  QuoteChar := #0
1516  else
1517  QuoteChar := Tail^;
1518  InQuote := QuoteChar <> #0;
1519  Inc(Tail);
1520  end
1521  else
1522  Break;
1523  end;
1524  EOS := Tail^ = #0;
1525  if (Head <> Tail) and (Head^ <> #0) then
1526  begin
1527  if Strings <> nil then
1528  begin
1529  SetString(Item, Head, Tail - Head);
1530  Strings.Add(Item);
1531  end;
1532  Inc(Result);
1533  end;
1534  Inc(Tail);
1535  until EOS;
1536  finally
1537  Strings.EndUpdate;
1538  end;
1539 end;
1540 {$ENDIF}
1541 
1542 var
1543  SL: TStringList;
1544  I: Integer;
1545 begin
1546  SL := TStringList.Create;
1547  try
1548  Catalog := '';
1549  Schema := '';
1550  ObjectName := QualifiedName;
1551  ExtractStrings(['.'], [' '], PChar(QualifiedName), SL);
1552  case SL.Count of
1553  0, 1: ;
1554  2: begin
1555  Schema := SL.Strings[0];
1556  ObjectName := SL.Strings[1];
1557  end;
1558  3: begin
1559  Catalog := SL.Strings[0];
1560  Schema := SL.Strings[1];
1561  ObjectName := SL.Strings[2];
1562  end;
1563  else
1564  begin
1565  ObjectName := SL.Strings[SL.Count - 1];
1566  Schema := SL.Strings[SL.Count - 2];
1567  for I := 0 to SL.Count - 3 do
1568  begin
1569  Catalog := Catalog + SL.Strings[I];
1570  if I < SL.Count - 3 then
1571  Catalog := Catalog + '.';
1572  end;
1573  end;
1574  end;
1575  finally
1576  SL.Free;
1577  end;
1578 end;
1579 
1580 {**
1581  Splits up a qualified object name into pieces. Catalog, schema
1582  and objectname.
1583 }
1584 procedure SplitQualifiedObjectName(QualifiedName: string;
1585  const SupportsCatalogs, SupportsSchemas: Boolean;
1586  var Catalog, Schema, ObjectName: string);
1587 var
1588  SL: TStringList;
1589  I: Integer;
1590 begin
1591  if SupportsCatalogs and SupportsSchemas then
1592  SplitQualifiedObjectName(QualifiedName, Catalog, Schema, ObjectName)
1593  else
1594  begin
1595  SL := TStringList.Create;
1596  try
1597  Catalog := '';
1598  Schema := '';
1599  ObjectName := QualifiedName;
1600  ExtractStrings(['.'], [' '], PChar(QualifiedName), SL);
1601  case SL.Count of
1602  0, 1: ;
1603  2:
1604  begin
1605  if SupportsCatalogs then
1606  begin
1607  Catalog := SL.Strings[0];
1608  if SupportsSchemas then
1609  Schema := SL.Strings[1]
1610  else
1611  ObjectName := SL.Strings[1];
1612  end
1613  else
1614  if SupportsSchemas then
1615  begin
1616  Schema := SL.Strings[0];
1617  ObjectName := SL.Strings[1];
1618  end
1619  else
1620  ObjectName := SL.Strings[0]+'.'+SL.Strings[1];
1621  end;
1622  3:
1623  if SupportsCatalogs then
1624  begin
1625  Catalog := SL.Strings[0];
1626  if SupportsSchemas then
1627  begin
1628  Schema := SL.Strings[1];
1629  ObjectName := SL.Strings[2]
1630  end
1631  else
1632  ObjectName := SL.Strings[1]+'.'+SL.Strings[2];
1633  end
1634  else
1635  if SupportsSchemas then
1636  begin
1637  Schema := SL.Strings[0];
1638  ObjectName := SL.Strings[1]+'.'+SL.Strings[2];
1639  end
1640  else
1641  ObjectName := SL.Strings[0]+'.'+SL.Strings[1]+'.'+SL.Strings[2];
1642  else
1643  if SupportsCatalogs then
1644  begin
1645  Catalog := SL.Strings[0];
1646  if SupportsSchemas then
1647  begin
1648  Schema := SL.Strings[1];
1649  for i := 2 to SL.Count-1 do
1650  if i = 2 then
1651  ObjectName := SL.Strings[i]
1652  else
1653  ObjectName := ObjectName+'.'+SL.Strings[i];
1654  end
1655  else
1656  begin
1657  ObjectName := '';
1658  for i := 2 to SL.Count-1 do
1659  if I = 2 then
1660  ObjectName := SL.Strings[i]
1661  else
1662  ObjectName := ObjectName+'.'+SL.Strings[i];
1663  end;
1664  end
1665  else
1666  if SupportsSchemas then
1667  begin
1668  Schema := SL.Strings[0];
1669  for i := 1 to SL.Count-1 do
1670  if i = 1 then
1671  ObjectName := SL.Strings[i]
1672  else
1673  ObjectName := ObjectName+'.'+SL.Strings[i];
1674  end
1675  else
1676  for i := 0 to SL.Count-1 do
1677  if I = 0 then
1678  ObjectName := SL.Strings[i]
1679  else
1680  ObjectName := ObjectName+'.'+SL.Strings[i];
1681  end;
1682  finally
1683  SL.Free;
1684  end;
1685  end;
1686 end;
1687 
1688 {**
1689  Assigns a Statement value from a TParam
1690  @param Index the index of Statement.SetXxxx(ColumnIndex, xxx);
1691  @param Statement the PrepredStatement where the values have been assigned
1692  @param Param the TParam where the value is assigned from
1693 }
1694 procedure SetStatementParam(Index: Integer;
1695  Statement: IZPreparedStatement; Param: TParam);
1696 var
1697  Stream: TStream;
1698  TempBytes: TByteDynArray;
1699  {$IFDEF WITH_ASBYTES}Bts: TBytes;{$ENDIF}
1700  {$IFDEF WITHOUT_VARBYTESASSTRING}V: Variant;{$ENDIF}
1701 begin
1702  if Param.IsNull then
1703  Statement.SetNull(Index, ConvertDatasetToDbcType(Param.DataType))
1704  else
1705  begin
1706  case Param.DataType of
1707  ftBoolean:
1708  Statement.SetBoolean(Index, Param.AsBoolean);
1709  ftSmallInt{$IFDEF WITH_FTSHORTINT}, ftShortInt{$ENDIF}:
1710  Statement.SetShort(Index, Param.AsSmallInt);
1711  ftInteger, ftAutoInc{$IFDEF WITH_FTBYTE}, ftByte{$ENDIF}:
1712  Statement.SetInt(Index, Param.AsInteger);
1713  ftFloat{$IFDEF WITH_FTEXTENDED}, ftExtended{$ENDIF}:
1714  Statement.SetDouble(Index, Param.AsFloat);
1715  {$IFDEF WITH_FTLONGWORD}
1716  ftLongWord:
1717  Statement.SetInt(Index, Integer(Param.AsLongWord));
1718  {$ENDIF}
1719  ftLargeInt:
1720  Statement.SetLong(Index, StrToInt64(Param.AsString));
1721  ftCurrency, ftBCD:
1722  Statement.SetBigDecimal(Index, Param.AsCurrency);
1723  ftString, ftFixedChar:
1724  Statement.SetString(Index, Param.AsString);
1725  {$IFDEF WITH_FTWIDESTRING}
1726  ftWideString:
1727  Statement.SetUnicodeString(Index, Param.AsWideString);
1728  {$ENDIF}
1729  ftBytes, ftVarBytes{$IFDEF WITH_FTGUID}, ftGuid{$ENDIF}:
1730  begin
1731  {$IFDEF WITH_ASBYTES}
1732  Bts := Param.AsBytes;
1733  SetLength(TempBytes, High(Bts)+1);
1734  System.Move(PAnsichar(Bts)^, PAnsichar(TempBytes)^, High(Bts)+1);
1735  {$ELSE}
1736  {$IFDEF WITHOUT_VARBYTESASSTRING}
1737  V := Param.Value;
1738  TempBytes := V;
1739  {$ELSE}
1740  TempBytes := StrToBytes(Param.AsString);
1741  {$ENDIF}
1742  {$ENDIF}
1743  Statement.SetBytes(Index, TempBytes);
1744  end;
1745  ftDate:
1746  Statement.SetDate(Index, Param.AsDate);
1747  ftTime:
1748  Statement.SetTime(Index, Param.AsTime);
1749  ftDateTime:
1750  Statement.SetTimestamp(Index, Param.AsDateTime);
1751  ftMemo:
1752  begin
1753  {EgonHugeist: On reading a Param as Memo the Stream reads Byte-wise
1754  on Changing to stUnicodeString/Delphi12Up a String is from
1755  Type wide/unicode so we have to give him back as
1756  Stream!}
1757  {$IFDEF UNICODE}
1758  Stream := Param.AsStream;
1759  {$ELSE}
1760  Stream := TStringStream.Create(Param.AsMemo);
1761  {$ENDIF}
1762  try
1763  Statement.SetAsciiStream(Index, Stream);
1764  finally
1765  Stream.Free;
1766  end;
1767  end;
1768  {$IFDEF WITH_WIDEMEMO}
1769  ftWideMemo:
1770  begin
1771  Stream := WideStringStream(Param.AsWideString);
1772  try
1773  Statement.SetUnicodeStream(Index, Stream);
1774  finally
1775  Stream.Free;
1776  end;
1777  end;
1778  {$ENDIF}
1779  ftBlob, ftGraphic:
1780  begin
1781  Stream := TStringStream.Create(Param.AsBlob);
1782  try
1783  Statement.SetBinaryStream(Index, Stream);
1784  finally
1785  Stream.Free;
1786  end;
1787  end;
1788  else
1789  raise EZDatabaseError.Create(SUnKnownParamDataType + IntToStr(Ord(Param.DataType)));
1790  end;
1791  end;
1792 end;
1793 
1794 initialization
1795  CommonTokenizer := TZGenericSQLTokenizer.Create;
1796 finalization
1797  CommonTokenizer := nil;
1798 end.
1799