00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Dataset utility functions and classes }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZDatasetUtils;
00055
00056 interface
00057
00058 {$I ZComponent.inc}
00059
00060 uses
00061 {$IFNDEF VER130BELOW}
00062 Types,
00063 {$ENDIF}
00064 Classes, SysUtils, Db, ZSysUtils, ZDbcIntfs, ZDbcCache,
00065 Contnrs, ZCompatibility, ZExpression, ZVariant, ZTokenizer;
00066
00067 {**
00068 Converts DBC Field Type to TDataset Field Type.
00069 @param Value an initial DBC field type.
00070 @return a converted TDataset field type.
00071 }
00072 function ConvertDbcToDatasetType(Value: TZSQLType): TFieldType;
00073
00074 {**
00075 Converts TDataset Field Type to DBC Field Type.
00076 @param Value an initial TDataset field type.
00077 @return a converted DBC field type.
00078 }
00079 function ConvertDatasetToDbcType(Value: TFieldType): TZSQLType;
00080
00081 {**
00082 Converts field definitions into column information objects.
00083 @param Fields a collection of field definitions.
00084 @return a collection of column information objects.
00085 }
00086 function ConvertFieldsToColumnInfo(Fields: TFields): TObjectList;
00087
00088 {**
00089 Fetches columns from specified resultset.
00090 @param ResultSet a source resultset.
00091 @param FieldsLookupTable a lookup table to define original index.
00092 @param Fields a collection of field definitions.
00093 @param RowAccessor a destination row accessor.
00094 }
00095 procedure FetchFromResultSet(ResultSet: IZResultSet;
00096 const FieldsLookupTable: TIntegerDynArray; Fields: TFields;
00097 RowAccessor: TZRowAccessor);
00098
00099 {**
00100 Posts columns from specified resultset.
00101 @param ResultSet a source resultset.
00102 @param FieldsLookupTable a lookup table to define original index.
00103 @param Fields a collection of field definitions.
00104 @param RowAccessor a destination row accessor.
00105 }
00106 procedure PostToResultSet(ResultSet: IZResultSet;
00107 const FieldsLookupTable: TIntegerDynArray; Fields: TFields;
00108 RowAccessor: TZRowAccessor);
00109
00110 {**
00111 Defines fields indices for the specified dataset.
00112 @param DataSet a dataset object.
00113 @param FieldNames a list of field names.
00114 @param OnlyDataFields <code>True</code> if only data fields selected.
00115 }
00116 function DefineFields(DataSet: TDataset; const FieldNames: string;
00117 var OnlyDataFields: Boolean): TObjectDynArray;
00118
00119 {**
00120 Defins a indices of filter fields.
00121 @param Dataset a dataset object.
00122 @param Expression a expression calculator.
00123 @returns an array with field object references.
00124 }
00125 function DefineFilterFields(DataSet: TDataset;
00126 Expression: IZExpression): TObjectDynArray;
00127
00128 {**
00129 Retrieves a set of specified field values.
00130 @param FieldRefs an array with interested field object references.
00131 @param ResultSet an initial result set object.
00132 @param ResultValues a container for result values.
00133 @return an array with field values.
00134 }
00135 procedure RetrieveDataFieldsFromResultSet(const FieldRefs: TObjectDynArray;
00136 ResultSet: IZResultSet; var ResultValues: TZVariantDynArray);
00137
00138 {**
00139 Retrieves a set of specified field values.
00140 @param FieldRefs an array with interested field object references.
00141 @param FieldIndices an array with interested field indices.
00142 @param RowAccessor a row accessor object.
00143 @param ResultValues a container for result values.
00144 @return an array with field values.
00145 }
00146 procedure RetrieveDataFieldsFromRowAccessor(const FieldRefs: TObjectDynArray;
00147 const FieldIndices: TIntegerDynArray; RowAccessor: TZRowAccessor;
00148 var ResultValues: TZVariantDynArray);
00149
00150 {**
00151 Copy a set of specified field values to variables.
00152 @param Fields an array with interested field object references.
00153 @param ResultSet an initial result set object.
00154 @param Variables a list of variables.
00155 }
00156 procedure CopyDataFieldsToVars(const Fields: TObjectDynArray;
00157 ResultSet: IZResultSet; Variables: IZVariablesList);
00158
00159 {**
00160 Prepares values for comparison by CompareFieldsFromResultSet.
00161 @param FieldRefs an array with interested field object references.
00162 @param DecodedKeyValues given values.
00163 @param ResultSet a resultset to get field values.
00164 @param PartialKey <code>True</code> if values should be started with the keys.
00165 @param CaseInsensitive <code>True</code> if keys are case insensitive.
00166 }
00167 procedure PrepareValuesForComparison(const FieldRefs: TObjectDynArray;
00168 var DecodedKeyValues: TZVariantDynArray; ResultSet: IZResultSet;
00169 PartialKey: Boolean; CaseInsensitive: Boolean);
00170
00171 {**
00172 Compares row field values with the given ones.
00173 @param KeyValues given values.
00174 @param RowValues row field values.
00175 @param PartialKey <code>True</code> if values should be started with the keys.
00176 @param CaseInsensitive <code>True</code> if keys are case insensitive.
00177 @return <code> if values are equal.
00178 }
00179 function CompareDataFields(const KeyValues, RowValues: TZVariantDynArray;
00180 PartialKey: Boolean; CaseInsensitive: Boolean): Boolean;
00181
00182 {**
00183 Compares row field values with the given ones.
00184 @param FieldRefs an array with interested field object references.
00185 @param KeyValues given values.
00186 @param RowValues row field values.
00187 @param PartialKey <code>True</code> if values should be started with the keys.
00188 @param CaseInsensitive <code>True</code> if keys are case insensitive.
00189 @return <code> if values are equal.
00190 }
00191 function CompareFieldsFromResultSet(const FieldRefs: TObjectDynArray;
00192 const KeyValues: TZVariantDynArray; ResultSet: IZResultSet; PartialKey: Boolean;
00193 CaseInsensitive: Boolean): Boolean;
00194
00195 {**
00196 Defines a list of key field names.
00197 @param Fields a collection of dataset fields.
00198 @return a list of key field names.
00199 }
00200 function DefineKeyFields(Fields: TFields): string;
00201
00202 {**
00203 Converts datetime value into TDataset internal presentation.
00204 @param DataType a type of date-time field.
00205 @param Data a data which contains a value.
00206 @param Buffer a field buffer pointer
00207 }
00208 procedure DateTimeToNative(DataType: TFieldType; Data: TDateTime; Buffer: Pointer);
00209
00210 {**
00211 Converts date times from TDataset internal presentation into datetime value.
00212 @param DataType a type of date-time field.
00213 @param Buffer a field buffer pointer
00214 @return a data which contains a value.
00215 }
00216 function NativeToDateTime(DataType: TFieldType; Buffer: Pointer): TDateTime;
00217
00218 {**
00219 Compare values from two key fields.
00220 @param Field1 the first field object.
00221 @param ResultSet the resultset to read the first field value.
00222 @param Field2 the second field object.
00223 }
00224 function CompareKeyFields(Field1: TField; ResultSet: IZResultSet;
00225 Field2: TField): Boolean;
00226
00227 {**
00228 Defins a indices and directions for sorted fields.
00229 @param Dataset a dataset object.
00230 @param SortedFields an encoded fields for sorting in the format
00231 <Field Name> [ASC | DESC] [, ...]
00232 @param FieldRefs a decoded field object references.
00233 @param FieldDirs a decoded field directions.
00234 @param OnlyDataFields <code>True</code> if only data fields selected.
00235 }
00236 procedure DefineSortedFields(DataSet: TDataset;
00237 const SortedFields: string; var FieldRefs: TObjectDynArray;
00238 var FieldDirs: TBooleanDynArray; var OnlyDataFields: Boolean);
00239
00240 {**
00241 Creates a fields lookup table to define fixed position
00242 of the field in dataset.
00243 @param Fields a collection of TDataset fields in initial order.
00244 @returns a fields lookup table.
00245 }
00246 function CreateFieldsLookupTable(Fields: TFields): TIntegerDynArray;
00247
00248 {**
00249 Defines an original field index in the dataset.
00250 @param FieldsLookupTable a lookup table to define original index.
00251 @param Field a TDataset field object.
00252 @returns an original fields index or -1 otherwise.
00253 }
00254 function DefineFieldIndex(const FieldsLookupTable: TIntegerDynArray;
00255 Field: TField): Integer;
00256
00257 {**
00258 Defines an original field indices in the dataset.
00259 @param FieldsLookupTable a lookup table to define original index.
00260 @param FieldRefs a TDataset field object references.
00261 @returns an array with original fields indices.
00262 }
00263 function DefineFieldIndices(const FieldsLookupTable: TIntegerDynArray;
00264 const FieldRefs: TObjectDynArray): TIntegerDynArray;
00265
00266 {**
00267 Splits up a qualified object name into pieces. Catalog, schema
00268 and objectname.
00269 }
00270 procedure SplitQualifiedObjectName(QualifiedName: string;
00271 var Catalog, Schema, ObjectName: string);
00272
00273 {** Common variables. }
00274 var
00275 CommonTokenizer: IZTokenizer;
00276
00277 implementation
00278
00279 uses
00280 ZMessages, ZGenericSqlToken,
00281 ZDbcResultSetMetadata, ZAbstractRODataset;
00282
00283 {**
00284 Converts DBC Field Type to TDataset Field Type.
00285 @param Value an initial DBC field type.
00286 @return a converted TDataset field type.
00287 }
00288 function ConvertDbcToDatasetType(Value: TZSQLType): TFieldType;
00289 begin
00290 case Value of
00291 stBoolean:
00292 Result := ftBoolean;
00293 stByte, stShort:
00294 Result := ftSmallInt;
00295 stInteger:
00296 Result := ftInteger;
00297 stLong:
00298 Result := ftLargeInt;
00299 stFloat, stDouble, stBigDecimal:
00300 Result := ftFloat;
00301 stString:
00302 Result := ftString;
00303 stBytes:
00304 Result := ftBytes;
00305 stDate:
00306 Result := ftDate;
00307 stTime:
00308 Result := ftTime;
00309 stTimestamp:
00310 Result := ftDateTime;
00311 stAsciiStream:
00312 Result := ftMemo;
00313 stBinaryStream:
00314 Result := ftBlob;
00315 stUnicodeString, stUnicodeStream:
00316 Result := ftWideString;
00317 else
00318 Result := ftUnknown;
00319 end;
00320 end;
00321
00322 {**
00323 Converts TDataset Field Type to DBC Field Type.
00324 @param Value an initial TDataset field type.
00325 @return a converted DBC field type.
00326 }
00327 function ConvertDatasetToDbcType(Value: TFieldType): TZSQLType;
00328 begin
00329 case Value of
00330 ftBoolean:
00331 Result := stBoolean;
00332 ftSmallInt:
00333 Result := stShort;
00334 ftInteger, ftAutoInc:
00335 Result := stInteger;
00336 ftFloat:
00337 Result := stDouble;
00338 ftLargeInt:
00339 Result := stLong;
00340 ftCurrency:
00341 Result := stBigDecimal;
00342 ftString:
00343 Result := stString;
00344 ftBytes:
00345 Result := stBytes;
00346 ftDate:
00347 Result := stDate;
00348 ftTime:
00349 Result := stTime;
00350 ftDateTime:
00351 Result := stTimestamp;
00352 ftMemo:
00353 Result := stAsciiStream;
00354 ftBlob:
00355 Result := stBinaryStream;
00356 ftWideString:
00357 Result := stUnicodeString;
00358 else
00359 Result := stUnknown;
00360 end;
00361 end;
00362
00363 {**
00364 Converts field definitions into column information objects.
00365 @param Fields a collection of field definitions.
00366 @return a collection of column information objects.
00367 }
00368 function ConvertFieldsToColumnInfo(Fields: TFields): TObjectList;
00369 var
00370 I: Integer;
00371 Current: TField;
00372 ColumnInfo: TZColumnInfo;
00373 begin
00374 Result := TObjectList.Create;
00375 for I := 0 to Fields.Count - 1 do
00376 begin
00377 Current := Fields[I];
00378 ColumnInfo := TZColumnInfo.Create;
00379
00380 ColumnInfo.ColumnType := ConvertDatasetToDbcType(Current.DataType);
00381 ColumnInfo.ColumnName := Current.FieldName;
00382 ColumnInfo.Precision := Current.Size;
00383
00384 if ColumnInfo.ColumnType = stUnicodeString then
00385 if Current.Size > 10240 then
00386 ColumnInfo.ColumnType := stUnicodeStream;
00387 ColumnInfo.Scale := 0;
00388 ColumnInfo.ColumnLabel := Current.DisplayName;
00389
00390 Result.Add(ColumnInfo);
00391 end;
00392 end;
00393
00394 {**
00395 Fetches columns from specified resultset.
00396 @param ResultSet a source resultset.
00397 @param FieldsLookupTable a lookup table to define original index.
00398 @param Fields a collection of field definitions.
00399 @param RowAccessor a destination row accessor.
00400 }
00401 procedure FetchFromResultSet(ResultSet: IZResultSet;
00402 const FieldsLookupTable: TIntegerDynArray; Fields: TFields;
00403 RowAccessor: TZRowAccessor);
00404 var
00405 I, FieldIndex: Integer;
00406 Current: TField;
00407 ColumnIndex, ColumnCount: Integer;
00408 begin
00409 RowAccessor.RowBuffer.Index := ResultSet.GetRow;
00410 ColumnCount := ResultSet.GetMetadata.GetColumnCount;
00411
00412 for I := 0 to Fields.Count - 1 do
00413 begin
00414 Current := Fields[I];
00415 if not (Current.FieldKind in [fkData, fkInternalCalc]) then
00416 Continue;
00417
00418 ColumnIndex := Current.FieldNo;
00419 FieldIndex := DefineFieldIndex(FieldsLookupTable, Current);
00420 if (ColumnIndex < 1) or (ColumnIndex > ColumnCount) then
00421 Continue;
00422
00423 case Current.DataType of
00424 ftBoolean:
00425 RowAccessor.SetBoolean(FieldIndex, ResultSet.GetBoolean(ColumnIndex));
00426 ftSmallInt:
00427 RowAccessor.SetShort(FieldIndex, ResultSet.GetShort(ColumnIndex));
00428 ftInteger, ftAutoInc:
00429 RowAccessor.SetInt(FieldIndex, ResultSet.GetInt(ColumnIndex));
00430 ftFloat:
00431 RowAccessor.SetDouble(FieldIndex, ResultSet.GetDouble(ColumnIndex));
00432 ftLargeInt:
00433 RowAccessor.SetLong(FieldIndex, ResultSet.GetLong(ColumnIndex));
00434 ftCurrency:
00435 RowAccessor.SetBigDecimal(FieldIndex, ResultSet.GetBigDecimal(ColumnIndex));
00436 ftString:
00437 RowAccessor.SetPChar(FieldIndex, ResultSet.GetPChar(ColumnIndex));
00438 ftWidestring:
00439 RowAccessor.SetUnicodeString(FieldIndex, ResultSet.GetUnicodeString(ColumnIndex));
00440 ftBytes:
00441 RowAccessor.SetBytes(FieldIndex, ResultSet.GetBytes(ColumnIndex));
00442 ftDate:
00443 RowAccessor.SetDate(FieldIndex, ResultSet.GetDate(ColumnIndex));
00444 ftTime:
00445 RowAccessor.SetTime(FieldIndex, ResultSet.GetTime(ColumnIndex));
00446 ftDateTime:
00447 RowAccessor.SetTimestamp(FieldIndex, ResultSet.GetTimestamp(ColumnIndex));
00448 ftMemo, ftBlob:
00449 RowAccessor.SetBlob(FieldIndex, ResultSet.GetBlob(ColumnIndex));
00450 end;
00451
00452 if ResultSet.WasNull then
00453 RowAccessor.SetNull(FieldIndex);
00454 end;
00455 end;
00456
00457 {**
00458 Posts columns from specified resultset.
00459 @param ResultSet a source resultset.
00460 @param FieldsLookupTable a lookup table to define original index.
00461 @param Fields a collection of field definitions.
00462 @param RowAccessor a destination row accessor.
00463 }
00464 procedure PostToResultSet(ResultSet: IZResultSet;
00465 const FieldsLookupTable: TIntegerDynArray; Fields: TFields;
00466 RowAccessor: TZRowAccessor);
00467 var
00468 I, FieldIndex: Integer;
00469 Current: TField;
00470 WasNull: Boolean;
00471 ColumnIndex, ColumnCount: Integer;
00472 Stream: TStream;
00473 begin
00474 WasNull := False;
00475 RowAccessor.RowBuffer.Index := ResultSet.GetRow;
00476 ColumnCount := ResultSet.GetMetadata.GetColumnCount;
00477
00478 for I := 0 to Fields.Count - 1 do
00479 begin
00480 Current := Fields[I];
00481 if Current.FieldKind <> fkData then
00482 Continue;
00483
00484 ColumnIndex := Current.FieldNo;
00485 FieldIndex := DefineFieldIndex(FieldsLookupTable, Current);
00486 if (ColumnIndex < 1) or (ColumnIndex > ColumnCount) then
00487 Continue;
00488
00489
00490
00491
00492 case Current.DataType of
00493 ftBoolean:
00494 ResultSet.UpdateBoolean(ColumnIndex, RowAccessor.GetBoolean(FieldIndex, WasNull));
00495 ftSmallInt:
00496 ResultSet.UpdateShort(ColumnIndex, RowAccessor.GetShort(FieldIndex, WasNull));
00497 ftInteger, ftAutoInc:
00498 ResultSet.UpdateInt(ColumnIndex, RowAccessor.GetInt(FieldIndex, WasNull));
00499 ftFloat:
00500 ResultSet.UpdateDouble(ColumnIndex, RowAccessor.GetDouble(FieldIndex, WasNull));
00501 ftLargeInt:
00502 ResultSet.UpdateLong(ColumnIndex, RowAccessor.GetLong(FieldIndex, WasNull));
00503 ftCurrency:
00504 ResultSet.UpdateBigDecimal(ColumnIndex,
00505 RowAccessor.GetBigDecimal(FieldIndex, WasNull));
00506 ftString:
00507 ResultSet.UpdatePChar(ColumnIndex, RowAccessor.GetPChar(FieldIndex, WasNull));
00508 ftWidestring:
00509 ResultSet.UpdateUnicodeString(ColumnIndex,
00510 RowAccessor.GetUnicodeString(FieldIndex, WasNull));
00511 ftBytes:
00512 ResultSet.UpdateBytes(ColumnIndex, RowAccessor.GetBytes(FieldIndex, WasNull));
00513 ftDate:
00514 ResultSet.UpdateDate(ColumnIndex, RowAccessor.GetDate(FieldIndex, WasNull));
00515 ftTime:
00516 ResultSet.UpdateTime(ColumnIndex, RowAccessor.GetTime(FieldIndex, WasNull));
00517 ftDateTime:
00518 ResultSet.UpdateTimestamp(ColumnIndex,
00519 RowAccessor.GetTimestamp(FieldIndex, WasNull));
00520 ftMemo:
00521 begin
00522 Stream := RowAccessor.GetAsciiStream(FieldIndex, WasNull);
00523 try
00524 ResultSet.UpdateAsciiStream(ColumnIndex, Stream);
00525 finally
00526 Stream.Free;
00527 end;
00528 end;
00529 ftBlob:
00530 begin
00531 Stream := RowAccessor.GetBinaryStream(FieldIndex, WasNull);
00532 try
00533 ResultSet.UpdateBinaryStream(ColumnIndex, Stream);
00534 finally
00535 Stream.Free;
00536 end;
00537 end;
00538 end;
00539
00540 if WasNull then
00541 ResultSet.UpdateNull(ColumnIndex);
00542 end;
00543 end;
00544
00545 {**
00546 Defines fields indices for the specified dataset.
00547 @param DataSet a dataset object.
00548 @param FieldNames a list of field names.
00549 @param OnlyDataFields <code>True</code> if only data fields selected.
00550 }
00551 function DefineFields(DataSet: TDataset; const FieldNames: string;
00552 var OnlyDataFields: Boolean): TObjectDynArray;
00553 var
00554 I: Integer;
00555 Tokens: TStrings;
00556 TokenType: TZTokenType;
00557 TokenValue: string;
00558 Field: TField;
00559 FieldCount: Integer;
00560 begin
00561 OnlyDataFields := True;
00562 FieldCount := 0;
00563 SetLength(Result, FieldCount);
00564 Tokens := CommonTokenizer.TokenizeBufferToList(FieldNames,
00565 [toSkipEOF, toSkipWhitespaces, toUnifyNumbers, toDecodeStrings]);
00566
00567 try
00568 for I := 0 to Tokens.Count - 1 do
00569 begin
00570 TokenType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
00571 Tokens.Objects[I]{$IFDEF FPC}){$ENDIF});
00572 TokenValue := Tokens[I];
00573 Field := nil;
00574
00575 if TokenType in [ttWord, ttQuoted] then
00576 begin
00577 Field := DataSet.FieldByName(TokenValue);
00578 end
00579 else if (TokenType = ttNumber)
00580 and (StrToIntDef(TokenValue, 0) < Dataset.Fields.Count) then
00581 begin
00582 Field := Dataset.Fields[StrToIntDef(TokenValue, 0)];
00583 end
00584 else if (TokenValue <> ',') and (TokenValue <> ';') then
00585 begin
00586 raise EZDatabaseError.Create(Format(SIncorrectSymbol, [TokenValue]));
00587 end;
00588
00589 if Field <> nil then
00590 begin
00591 OnlyDataFields := OnlyDataFields and (Field.FieldKind = fkData);
00592 Inc(FieldCount);
00593 SetLength(Result, FieldCount);
00594 Result[FieldCount - 1] := Field;
00595 end;
00596 end;
00597 finally
00598 Tokens.Free;
00599 end;
00600
00601 if Length(Result) = 0 then
00602 Result := nil;
00603 end;
00604
00605 {**
00606 Defins a indices of filter fields.
00607 @param Dataset a dataset object.
00608 @param Expression a expression calculator.
00609 @returns an array with field object references.
00610 }
00611 function DefineFilterFields(DataSet: TDataset;
00612 Expression: IZExpression): TObjectDynArray;
00613 var
00614 I: Integer;
00615 Current: TField;
00616 begin
00617 if Expression.Expression <> '' then
00618 begin
00619 SetLength(Result, Expression.DefaultVariables.Count);
00620 for I := 0 to Expression.DefaultVariables.Count - 1 do
00621 begin
00622 Current := DataSet.FindField(Expression.DefaultVariables.Names[I]);
00623 if Current <> nil then
00624 Result[I] := Current
00625 else Result[I] := nil;
00626 end;
00627 end else
00628 SetLength(Result, 0);
00629 end;
00630
00631 {**
00632 Retrieves a set of specified field values.
00633 @param FieldRefs an array with interested field object references.
00634 @param ResultSet an initial result set object.
00635 @param ResultValues a container for result values.
00636 @return an array with field values.
00637 }
00638 procedure RetrieveDataFieldsFromResultSet(const FieldRefs: TObjectDynArray;
00639 ResultSet: IZResultSet; var ResultValues: TZVariantDynArray);
00640 var
00641 I, ColumnIndex: Integer;
00642 begin
00643 for I := 0 to High(FieldRefs) do
00644 begin
00645 ColumnIndex := TField(FieldRefs[I]).FieldNo;
00646 case TField(FieldRefs[I]).DataType of
00647 ftString:
00648 DefVarManager.SetAsString(ResultValues[I],
00649 ResultSet.GetString(ColumnIndex));
00650 ftBoolean:
00651 DefVarManager.SetAsBoolean(ResultValues[I],
00652 ResultSet.GetBoolean(ColumnIndex));
00653 ftSmallInt, ftInteger, ftAutoInc:
00654 DefVarManager.SetAsInteger(ResultValues[I],
00655 ResultSet.GetInt(ColumnIndex));
00656 ftFloat:
00657 DefVarManager.SetAsFloat(ResultValues[I],
00658 ResultSet.GetDouble(ColumnIndex));
00659 ftLargeInt:
00660 DefVarManager.SetAsInteger(ResultValues[I],
00661 ResultSet.GetLong(ColumnIndex));
00662 ftCurrency:
00663 DefVarManager.SetAsFloat(ResultValues[I],
00664 ResultSet.GetBigDecimal(ColumnIndex));
00665 ftDate, ftTime, ftDateTime:
00666 DefVarManager.SetAsDateTime(ResultValues[I],
00667 ResultSet.GetTimestamp(ColumnIndex));
00668 ftWidestring:
00669 DefVarManager.SetAsUnicodeString(ResultValues[I],
00670 ResultSet.GetUnicodeString(ColumnIndex));
00671 else
00672 DefVarManager.SetAsString(ResultValues[I],
00673 ResultSet.GetString(ColumnIndex));
00674 end;
00675 if ResultSet.WasNull then
00676 ResultValues[I] := NullVariant;
00677 end;
00678 end;
00679
00680 {**
00681 Retrieves a set of specified field values.
00682 @param FieldRefs an array with interested field object references.
00683 @param FieldIndices an array with interested field indices.
00684 @param RowAccessor a row accessor object.
00685 @param ResultValues a container for result values.
00686 @return an array with field values.
00687 }
00688 procedure RetrieveDataFieldsFromRowAccessor(const FieldRefs: TObjectDynArray;
00689 const FieldIndices: TIntegerDynArray; RowAccessor: TZRowAccessor;
00690 var ResultValues: TZVariantDynArray);
00691 var
00692 I: Integer;
00693 ColumnIndex: Integer;
00694 WasNull: Boolean;
00695 begin
00696 WasNull := False;
00697 for I := 0 to High(FieldRefs) do
00698 begin
00699 ColumnIndex := FieldIndices[I];
00700 case TField(FieldRefs[I]).DataType of
00701 ftString:
00702 DefVarManager.SetAsString(ResultValues[I],
00703 RowAccessor.GetString(ColumnIndex, WasNull));
00704 ftBoolean:
00705 DefVarManager.SetAsBoolean(ResultValues[I],
00706 RowAccessor.GetBoolean(ColumnIndex, WasNull));
00707 ftSmallInt, ftInteger, ftAutoInc:
00708 DefVarManager.SetAsInteger(ResultValues[I],
00709 RowAccessor.GetInt(ColumnIndex, WasNull));
00710 ftFloat:
00711 DefVarManager.SetAsFloat(ResultValues[I],
00712 RowAccessor.GetDouble(ColumnIndex, WasNull));
00713 ftLargeInt:
00714 DefVarManager.SetAsInteger(ResultValues[I],
00715 RowAccessor.GetLong(ColumnIndex, WasNull));
00716 ftCurrency:
00717 DefVarManager.SetAsFloat(ResultValues[I],
00718 RowAccessor.GetBigDecimal(ColumnIndex, WasNull));
00719 ftDate, ftTime, ftDateTime:
00720 DefVarManager.SetAsDateTime(ResultValues[I],
00721 RowAccessor.GetTimestamp(ColumnIndex, WasNull));
00722 ftWidestring:
00723 DefVarManager.SetAsUnicodeString(ResultValues[I],
00724 RowAccessor.GetUnicodeString(ColumnIndex, WasNull));
00725 else
00726 DefVarManager.SetAsString(ResultValues[I],
00727 RowAccessor.GetString(ColumnIndex, WasNull));
00728 end;
00729 if WasNull then
00730 ResultValues[I] := NullVariant;
00731 end;
00732 end;
00733
00734 {**
00735 Copy a set of specified field values to variables.
00736 @param Fields an array with interested field object references.
00737 @param ResultSet an initial result set object.
00738 @param Variables a list of variables.
00739 }
00740 procedure CopyDataFieldsToVars(const Fields: TObjectDynArray;
00741 ResultSet: IZResultSet; Variables: IZVariablesList);
00742 var
00743 I, ColumnIndex: Integer;
00744 Temp: TZVariant;
00745 begin
00746 for I := 0 to Length(Fields) - 1 do
00747 begin
00748 if Fields[I] = nil then Continue;
00749
00750 ColumnIndex := TField(Fields[I]).FieldNo;
00751 if not ResultSet.IsNull(ColumnIndex) then
00752 begin
00753 case TField(Fields[I]).DataType of
00754 ftBoolean:
00755 DefVarManager.SetAsBoolean(Temp, ResultSet.GetBoolean(ColumnIndex));
00756 ftSmallInt, ftInteger, ftAutoInc:
00757 DefVarManager.SetAsInteger(Temp, ResultSet.GetInt(ColumnIndex));
00758 ftFloat:
00759 DefVarManager.SetAsFloat(Temp, ResultSet.GetDouble(ColumnIndex));
00760 ftLargeInt:
00761 DefVarManager.SetAsInteger(Temp, ResultSet.GetLong(ColumnIndex));
00762 ftCurrency:
00763 DefVarManager.SetAsFloat(Temp, ResultSet.GetBigDecimal(ColumnIndex));
00764 ftDate:
00765 DefVarManager.SetAsDateTime(Temp, ResultSet.GetDate(ColumnIndex));
00766 ftTime:
00767 DefVarManager.SetAsDateTime(Temp, ResultSet.GetTime(ColumnIndex));
00768 ftDateTime:
00769 DefVarManager.SetAsDateTime(Temp, ResultSet.GetTimestamp(ColumnIndex));
00770 ftWidestring:
00771 DefVarManager.SetAsUnicodeString(Temp,
00772 ResultSet.GetUnicodeString(ColumnIndex));
00773 else
00774 DefVarManager.SetAsString(Temp, ResultSet.GetString(ColumnIndex));
00775 end;
00776 Variables.Values[I] := Temp;
00777 end
00778 else
00779 begin
00780 DefVarManager.SetNull(Temp);
00781 Variables.Values[I] := Temp;
00782 end;
00783 end;
00784 end;
00785
00786 {**
00787 Compares row field values with the given ones.
00788 @param KeyValues given values.
00789 @param RowValues row field values.
00790 @param PartialKey <code>True</code> if values should be started with the keys.
00791 @param CaseInsensitive <code>True</code> if keys are case insensitive.
00792 @return <code> if values are equal.
00793 }
00794 function CompareDataFields(const KeyValues, RowValues: TZVariantDynArray;
00795 PartialKey: Boolean; CaseInsensitive: Boolean): Boolean;
00796 var
00797 I: Integer;
00798 Value1, Value2: AnsiString;
00799 begin
00800 Result := True;
00801 for I := 0 to High(KeyValues) do
00802 begin
00803 if CaseInsensitive then
00804 begin
00805 Value1 := AnsiUpperCase(SoftVarManager.GetAsString(KeyValues[I]));
00806 Value2 := AnsiUpperCase(SoftVarManager.GetAsString(RowValues[I]));
00807
00808 if PartialKey then
00809 begin
00810 Result := AnsiStrLComp(PChar(Value2), PChar(Value1), Length(Value1)) = 0;
00811 end else
00812 Result := Value1 = Value2;
00813 end
00814 else
00815 begin
00816 if PartialKey then
00817 begin
00818 Value1 := SoftVarManager.GetAsString(KeyValues[I]);
00819 Value2 := SoftVarManager.GetAsString(RowValues[I]);
00820 Result := AnsiStrLComp(PChar(Value2), PChar(Value1), Length(Value1)) = 0;
00821 end else
00822 Result := SoftVarManager.Compare(KeyValues[I], RowValues[I]) = 0;
00823 end;
00824
00825 if not Result then
00826 Break;
00827 end;
00828 end;
00829
00830 {**
00831 Prepares values for comparison by CompareFieldsFromResultSet.
00832 @param FieldRefs an array with interested field object references.
00833 @param DecodedKeyValues given values.
00834 @param ResultSet a resultset to get field values.
00835 @param PartialKey <code>True</code> if values should be started with the keys.
00836 @param CaseInsensitive <code>True</code> if keys are case insensitive.
00837 }
00838 procedure PrepareValuesForComparison(const FieldRefs: TObjectDynArray;
00839 var DecodedKeyValues: TZVariantDynArray; ResultSet: IZResultSet;
00840 PartialKey: Boolean; CaseInsensitive: Boolean);
00841 var
00842 I: Integer;
00843 Current: TField;
00844 CurrentType : TZSQLType;
00845 begin
00846 { Preprocesses cycle variables. }
00847 for I := 0 to High(FieldRefs) do
00848 begin
00849 Current := TField(FieldRefs[I]);
00850
00851 if DecodedKeyValues[I].VType = vtNull then
00852 Continue;
00853
00854 CurrentType := ResultSet.GetMetadata.GetColumnType(Current.FieldNo);
00855
00856 if PartialKey then
00857 begin
00858 if CurrentType = stUnicodeString then
00859 begin
00860 DecodedKeyValues[I] := SoftVarManager.Convert(
00861 DecodedKeyValues[I], vtUnicodeString);
00862 if CaseInsensitive then
00863 begin
00864 if DecodedKeyValues[I].VType = vtString then
00865 begin
00866 DecodedKeyValues[I].VString := Uppercase(DecodedKeyValues[I].VString);
00867 DecodedKeyValues[I].VUnicodeString := DecodedKeyValues[I].VString;
00868 end
00869 else
00870 begin
00871 {$IFNDEF VER130BELOW}
00872 DecodedKeyValues[I].VUnicodeString :=
00873 WideUpperCase(DecodedKeyValues[I].VUnicodeString);
00874 {$ELSE}
00875 DecodedKeyValues[I].VUnicodeString :=
00876 AnsiUpperCase(DecodedKeyValues[I].VUnicodeString);
00877 {$ENDIF}
00878 end;
00879 end;
00880 end
00881 else
00882 begin
00883 DecodedKeyValues[I] := SoftVarManager.Convert(
00884 DecodedKeyValues[I], vtString);
00885 if CaseInsensitive then
00886 begin
00887 DecodedKeyValues[I].VString :=
00888 AnsiUpperCase(DecodedKeyValues[I].VString);
00889 end;
00890 end;
00891 end
00892 else
00893 begin
00894 case CurrentType of
00895 stBoolean:
00896 DecodedKeyValues[I] := SoftVarManager.Convert(
00897 DecodedKeyValues[I], vtBoolean);
00898 stByte, stShort, stInteger, stLong:
00899 DecodedKeyValues[I] := SoftVarManager.Convert(
00900 DecodedKeyValues[I], vtInteger);
00901 stFloat, stDouble, stBigDecimal:
00902 DecodedKeyValues[I] := SoftVarManager.Convert(
00903 DecodedKeyValues[I], vtFloat);
00904 stUnicodeString:
00905 begin
00906 if CaseInsensitive then
00907 begin
00908 if DecodedKeyValues[I].VType = vtString then
00909 begin
00910 DecodedKeyValues[I].VString := Uppercase(DecodedKeyValues[I].VString);
00911 DecodedKeyValues[I].VUnicodeString := DecodedKeyValues[I].VString;
00912 end
00913 else
00914 begin
00915 {$IFNDEF VER130BELOW}
00916 DecodedKeyValues[I].VUnicodeString :=
00917 WideUpperCase(DecodedKeyValues[I].VUnicodeString);
00918 {$ELSE}
00919 DecodedKeyValues[I].VUnicodeString :=
00920 AnsiUpperCase(DecodedKeyValues[I].VUnicodeString);
00921 {$ENDIF}
00922 end;
00923 end
00924 else
00925 begin
00926 DecodedKeyValues[I] := SoftVarManager.Convert(
00927 DecodedKeyValues[I], vtUnicodeString);
00928 end;
00929 end;
00930 stDate, stTime, stTimestamp:
00931 DecodedKeyValues[I] := SoftVarManager.Convert(
00932 DecodedKeyValues[I], vtDateTime);
00933 else
00934 if CaseInsensitive then
00935 begin
00936 DecodedKeyValues[I] := SoftVarManager.Convert(
00937 DecodedKeyValues[I], vtString);
00938 DecodedKeyValues[I].VString :=
00939 AnsiUpperCase(DecodedKeyValues[I].VString);
00940 end
00941 else
00942 begin
00943 DecodedKeyValues[I] := SoftVarManager.Convert(
00944 DecodedKeyValues[I], vtString);
00945 end;
00946 end;
00947 end;
00948 end;
00949 end;
00950
00951 {**
00952 Compares row field values with the given ones.
00953 @param FieldRefs an array with interested field object references.
00954 @param KeyValues given values.
00955 @param ResultSet a resultset to get field values.
00956 @param PartialKey <code>True</code> if values should be started with the keys.
00957 @param CaseInsensitive <code>True</code> if keys are case insensitive.
00958 @return <code> if values are equal.
00959 }
00960 function CompareFieldsFromResultSet(const FieldRefs: TObjectDynArray;
00961 const KeyValues: TZVariantDynArray; ResultSet: IZResultSet; PartialKey: Boolean;
00962 CaseInsensitive: Boolean): Boolean;
00963 var
00964 I: Integer;
00965 ColumnIndex: Integer;
00966 Value1, Value2: AnsiString;
00967 CurrentType : TZSQLType;
00968 begin
00969 Result := True;
00970 for I := 0 to High(KeyValues) do
00971 begin
00972 ColumnIndex := TField(FieldRefs[I]).FieldNo;
00973
00974 if KeyValues[I].VType = vtNull then
00975 begin
00976 Result := ResultSet.IsNull(ColumnIndex);
00977 if not Result then Break;
00978 Continue;
00979 end;
00980
00981 CurrentType := ResultSet.GetMetadata.GetColumnType(ColumnIndex);
00982
00983 if PartialKey then
00984 begin
00985 if CurrentType = stUnicodeString then
00986 begin
00987 Value1 := KeyValues[I].VUnicodeString;
00988 Value2 := ResultSet.GetUnicodeString(ColumnIndex);
00989 end
00990 else
00991 begin
00992 Value1 := KeyValues[I].VString;
00993 Value2 := ResultSet.GetString(ColumnIndex);
00994 end;
00995
00996 if CaseInsensitive then
00997 Value2 := AnsiUpperCase(Value2);
00998 Result := AnsiStrLComp(PChar(Value2), PChar(Value1), Length(Value1)) = 0;
00999 end
01000 else
01001 begin
01002 case CurrentType of
01003 stBoolean:
01004 begin
01005 Result := KeyValues[I].VBoolean =
01006 ResultSet.GetBoolean(ColumnIndex);
01007 end;
01008 stByte,
01009 stShort,
01010 stInteger,
01011 stLong:
01012 begin
01013 Result := KeyValues[I].VInteger =
01014 ResultSet.GetLong(ColumnIndex);
01015 end;
01016 stFloat,
01017 stDouble,
01018 stBigDecimal:
01019 begin
01020 Result := Abs(KeyValues[I].VFloat -
01021 ResultSet.GetBigDecimal(ColumnIndex)) < FLOAT_COMPARE_PRECISION;
01022 end;
01023 stDate,
01024 stTime,
01025 stTimestamp:
01026 begin
01027 Result := KeyValues[I].VDateTime =
01028 ResultSet.GetTimestamp(ColumnIndex);
01029 end;
01030 stUnicodeString:
01031 begin
01032 if CaseInsensitive then
01033 begin
01034 {$IFNDEF VER130BELOW}
01035 Result := KeyValues[I].VUnicodeString =
01036 WideUpperCase(ResultSet.GetUnicodeString(ColumnIndex));
01037 {$ELSE}
01038 Result := AnsiString(KeyValues[I].VUnicodeString) =
01039 AnsiUpperCase(ResultSet.GetUnicodeString(ColumnIndex));
01040 {$ENDIF}
01041 end
01042 else
01043 begin
01044 Result := KeyValues[I].VUnicodeString =
01045 ResultSet.GetUnicodeString(ColumnIndex);
01046 end;
01047 end;
01048 else
01049 if CaseInsensitive then
01050 begin
01051 Result := KeyValues[I].VString =
01052 AnsiUpperCase(ResultSet.GetString(ColumnIndex));
01053 end
01054 else
01055 begin
01056 Result := KeyValues[I].VString =
01057 ResultSet.GetString(ColumnIndex);
01058 end;
01059 end;
01060 end;
01061
01062 Result := Result and not ResultSet.WasNull;
01063 if not Result then
01064 Break;
01065 end;
01066 end;
01067
01068 {**
01069 Defines a list of key field names.
01070 @param Fields a collection of dataset fields.
01071 @return a list of key field names.
01072 }
01073 function DefineKeyFields(Fields: TFields): string;
01074 var
01075 I: Integer;
01076 Temp: string;
01077 begin
01078 Result := '';
01079 for I := 0 to Fields.Count - 1 do
01080 begin
01081 if (Fields[I].FieldKind = fkData)
01082 and not (Fields[I].DataType in [ftBlob, ftMemo, ftBytes]) then
01083 begin
01084 if Result <> '' then
01085 Result := Result + ',';
01086 Temp := Fields[I].FieldName;
01087 if (Pos(' ', Temp) > 0) or (Pos('-', Temp) > 0) then
01088 Temp := '"' + Temp + '"';
01089 Result := Result + Temp;
01090 end;
01091 end;
01092 end;
01093
01094 {**
01095 Converts datetime value into TDataset internal presentation.
01096 @param DataType a type of date-time field.
01097 @param Data a data which contains a value.
01098 @param Buffer a field buffer pointer
01099 }
01100 procedure DateTimeToNative(DataType: TFieldType; Data: TDateTime;
01101 Buffer: Pointer);
01102 var
01103 TimeStamp: TTimeStamp;
01104 begin
01105 TimeStamp := DateTimeToTimeStamp(Data);
01106 case DataType of
01107 ftDate: Integer(Buffer^) := TimeStamp.Date;
01108 ftTime: Integer(Buffer^) := TimeStamp.Time;
01109 else
01110 TDateTime(Buffer^) := TimeStampToMSecs(TimeStamp);
01111 end;
01112 end;
01113
01114 {**
01115 Converts date times from TDataset internal presentation into datetime value.
01116 @param DataType a type of date-time field.
01117 @param Buffer a field buffer pointer
01118 @return a data which contains a value.
01119 }
01120 function NativeToDateTime(DataType: TFieldType; Buffer: Pointer): TDateTime;
01121 {$IFNDEF FPC}
01122 var
01123 TimeStamp: TTimeStamp;
01124 begin
01125 case DataType of
01126 ftDate:
01127 begin
01128 TimeStamp.Time := 0;
01129 TimeStamp.Date := Integer(Buffer^);
01130 end;
01131 ftTime:
01132 begin
01133 TimeStamp.Time := Integer(Buffer^);
01134 TimeStamp.Date := DateDelta;
01135 end;
01136 else
01137 try
01138 TimeStamp := MSecsToTimeStamp(TDateTime(Buffer^));
01139 except
01140 TimeStamp.Time := 0;
01141 TimeStamp.Date := 0;
01142 end;
01143 end;
01144 Result := TimeStampToDateTime(TimeStamp);
01145 {$ELSE}
01146 begin
01147 Result := TDateTime(Buffer^);
01148 {$ENDIF}
01149 end;
01150
01151 {**
01152 Compare values from two key fields.
01153 @param Field1 the first field object.
01154 @param ResultSet the resultset to read the first field value.
01155 @param Field2 the second field object.
01156 }
01157 function CompareKeyFields(Field1: TField; ResultSet: IZResultSet;
01158 Field2: TField): Boolean;
01159 begin
01160 Result := False;
01161 if Field1.FieldNo >= 1 then
01162 begin
01163 case Field1.DataType of
01164 ftBoolean:
01165 Result := ResultSet.GetBoolean(Field1.FieldNo) = Field2.AsBoolean;
01166 ftSmallInt, ftInteger, ftAutoInc:
01167 Result := ResultSet.GetInt(Field1.FieldNo) = Field2.AsInteger;
01168 ftFloat:
01169 begin
01170 Result := Abs(ResultSet.GetFloat(Field1.FieldNo)
01171 - Field2.AsFloat) < FLOAT_COMPARE_PRECISION;
01172 end;
01173 ftLargeInt:
01174 begin
01175 {$IFNDEF VER130BELOW}
01176 if Field2 is TLargeIntField then
01177 Result := ResultSet.GetLong(Field1.FieldNo)
01178 = TLargeIntField(Field2).AsLargeInt
01179 else
01180 {$ENDIF}
01181 Result := ResultSet.GetInt(Field1.FieldNo) = Field2.AsInteger;
01182 end;
01183 ftCurrency:
01184 begin
01185 Result := Abs(ResultSet.GetBigDecimal(Field1.FieldNo)
01186 - Field2.{$IFNDEF FPC}AsCurrency{$ELSE}AsFloat{$ENDIF})
01187 < FLOAT_COMPARE_PRECISION;
01188 end;
01189 ftDate:
01190 Result := ResultSet.GetDate(Field1.FieldNo) = Field2.AsDateTime;
01191 ftTime:
01192 Result := ResultSet.GetTime(Field1.FieldNo) = Field2.AsDateTime;
01193 ftDateTime:
01194 Result := ResultSet.GetTimestamp(Field1.FieldNo) = Field2.AsDateTime;
01195 ftWideString:
01196 Result := ResultSet.GetUnicodeString(Field1.FieldNo) =
01197 Field2.{$IFNDEF FPC}AsVariant{$ELSE}AsString{$ENDIF};
01198 else
01199 Result := ResultSet.GetString(Field1.FieldNo) = Field2.AsString;
01200 end;
01201 end;
01202 end;
01203
01204 {**
01205 Defins a indices and directions for sorted fields.
01206 @param Dataset a dataset object.
01207 @param SortedFields an encoded fields for sorting in the format
01208 <Field Name> [ASC | DESC] [, ...]
01209 @param FieldRefs a decoded field object references.
01210 @param FieldDirs a decoded field directions.
01211 @param OnlyDataFields <code>True</code> if only data fields selected.
01212 }
01213 procedure DefineSortedFields(DataSet: TDataset;
01214 const SortedFields: string; var FieldRefs: TObjectDynArray;
01215 var FieldDirs: TBooleanDynArray; var OnlyDataFields: Boolean);
01216 var
01217 I: Integer;
01218 Tokens: TStrings;
01219 TokenType: TZTokenType;
01220 TokenValue: string;
01221 Field: TField;
01222 FieldCount: Integer;
01223 begin
01224 OnlyDataFields := True;
01225 FieldCount := 0;
01226 SetLength(FieldRefs, FieldCount);
01227 SetLength(FieldDirs, FieldCount);
01228 Tokens := CommonTokenizer.TokenizeBufferToList(SortedFields,
01229 [toSkipEOF, toSkipWhitespaces, toUnifyNumbers, toDecodeStrings]);
01230
01231 try
01232 for I := 0 to Tokens.Count - 1 do
01233 begin
01234 TokenType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
01235 Tokens.Objects[I]{$IFDEF FPC}){$ENDIF});
01236 TokenValue := Tokens[I];
01237 Field := nil;
01238
01239 if ((UpperCase(TokenValue) = 'DESC')
01240 or (UpperCase(TokenValue) = 'ASC')) and (FieldCount > 0) then
01241 begin
01242 FieldDirs[FieldCount - 1] := (UpperCase(TokenValue) <> 'DESC');
01243 end
01244 else if TokenType in [ttWord, ttQuoted] then
01245 begin
01246 Field := DataSet.FieldByName(TokenValue)
01247 end
01248 else if (TokenType = ttNumber)
01249 and (StrToIntDef(TokenValue, 0) < Dataset.Fields.Count) then
01250 begin
01251 Field := Dataset.Fields[StrToIntDef(TokenValue, 0)];
01252 end
01253 else if (TokenValue <> ',') and (TokenValue <> ';') then
01254 begin
01255 raise EZDatabaseError.Create(Format(SIncorrectSymbol, [TokenValue]));
01256 end;
01257
01258 if Field <> nil then
01259 begin
01260 OnlyDataFields := OnlyDataFields and (Field.FieldKind = fkData);
01261 Inc(FieldCount);
01262 SetLength(FieldRefs, FieldCount);
01263 SetLength(FieldDirs, FieldCount);
01264 FieldRefs[FieldCount - 1] := Field;
01265 FieldDirs[FieldCount - 1] := True;
01266 end;
01267 end;
01268 finally
01269 Tokens.Free;
01270 end;
01271 end;
01272
01273 {**
01274 Creates a fields lookup table to define fixed position
01275 of the field in dataset.
01276 @param Fields a collection of TDataset fields in initial order.
01277 @returns a fields lookup table.
01278 }
01279 function CreateFieldsLookupTable(Fields: TFields): TIntegerDynArray;
01280 var
01281 I: Integer;
01282 begin
01283 SetLength(Result, Fields.Count);
01284 for I := 0 to Fields.Count - 1 do
01285 Result[I] := Integer(Fields[I]);
01286 end;
01287
01288 {**
01289 Defines an original field index in the dataset.
01290 @param FieldsLookupTable a lookup table to define original index.
01291 @param Field a TDataset field object.
01292 @returns an original fields index or -1 otherwise.
01293 }
01294 function DefineFieldIndex(const FieldsLookupTable: TIntegerDynArray;
01295 Field: TField): Integer;
01296 var
01297 I: Integer;
01298 begin
01299 Result := -1;
01300 for I := 0 to High(FieldsLookupTable) do
01301 begin
01302 if FieldsLookupTable[I] = Integer(Field) then
01303 begin
01304 Result := I + 1;
01305 Break;
01306 end;
01307 end;
01308 end;
01309
01310 {**
01311 Defines an original field indices in the dataset.
01312 @param FieldsLookupTable a lookup table to define original index.
01313 @param FieldRefs a TDataset field object references.
01314 @returns an array with original fields indices.
01315 }
01316 function DefineFieldIndices(const FieldsLookupTable: TIntegerDynArray;
01317 const FieldRefs: TObjectDynArray): TIntegerDynArray;
01318 var
01319 I: Integer;
01320 begin
01321 if FieldRefs = nil then
01322 begin
01323 Result := nil;
01324 Exit;
01325 end;
01326
01327 SetLength(Result, Length(FieldRefs));
01328 for I := 0 to High(Result) do
01329 Result[I] := DefineFieldIndex(FieldsLookupTable, TField(FieldRefs[I]));
01330 end;
01331
01332 {**
01333 Splits up a qualified object name into pieces. Catalog, schema
01334 and objectname.
01335 }
01336 procedure SplitQualifiedObjectName(QualifiedName: string;
01337 var Catalog, Schema, ObjectName: string);
01338
01339 {$IFDEF FPC}
01340 function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar;
01341 Strings: TStrings): Integer;
01342 var
01343 Head, Tail: PChar;
01344 EOS, InQuote: Boolean;
01345 QuoteChar: Char;
01346 Item: string;
01347 begin
01348 Result := 0;
01349 if (Content = nil) or (Content^=#0) or (Strings = nil) then Exit;
01350 Tail := Content;
01351 InQuote := False;
01352 QuoteChar := #0;
01353 Strings.BeginUpdate;
01354 try
01355 repeat
01356 while Tail^ in WhiteSpace + [#13, #10] do Inc(Tail);
01357 Head := Tail;
01358 while True do
01359 begin
01360 while (InQuote and not (Tail^ in [QuoteChar, #0])) or
01361 not (Tail^ in Separators + [#0, #13, #10, '''', '"']) do Inc(Tail);
01362 if Tail^ in ['''', '"'] then
01363 begin
01364 if (QuoteChar <> #0) and (QuoteChar = Tail^) then
01365 QuoteChar := #0
01366 else QuoteChar := Tail^;
01367 InQuote := QuoteChar <> #0;
01368 Inc(Tail);
01369 end else Break;
01370 end;
01371 EOS := Tail^ = #0;
01372 if (Head <> Tail) and (Head^ <> #0) then
01373 begin
01374 if Strings <> nil then
01375 begin
01376 SetString(Item, Head, Tail - Head);
01377 Strings.Add(Item);
01378 end;
01379 Inc(Result);
01380 end;
01381 Inc(Tail);
01382 until EOS;
01383 finally
01384 Strings.EndUpdate;
01385 end;
01386 end;
01387 {$ENDIF}
01388
01389 var
01390 SL: TStringList;
01391 I: Integer;
01392 begin
01393 SL := TStringList.Create;
01394 try
01395 Catalog := '';
01396 Schema := '';
01397 ObjectName := QualifiedName;
01398 ExtractStrings(['.'], [' '], PChar(QualifiedName), SL);
01399 case SL.Count of
01400 0, 1: ;
01401 2: begin
01402 Schema := SL.Strings[0];
01403 ObjectName := SL.Strings[1];
01404 end;
01405 3: begin
01406 Catalog := SL.Strings[0];
01407 Schema := SL.Strings[1];
01408 ObjectName := SL.Strings[2];
01409 end;
01410 else
01411 begin
01412 ObjectName := SL.Strings[SL.Count - 1];
01413 Schema := SL.Strings[SL.Count - 2];
01414 for I := 0 to SL.Count - 3 do
01415 begin
01416 Catalog := Catalog + SL.Strings[I];
01417 if I < SL.Count - 3 then
01418 Catalog := Catalog + '.';
01419 end;
01420 end;
01421 end;
01422 finally
01423 SL.Free;
01424 end;
01425 end;
01426
01427 initialization
01428 CommonTokenizer := TZGenericSQLTokenizer.Create;
01429 finalization
01430 CommonTokenizer := nil;
01431 end.
01432