zeoslib  UNKNOWN
 All Files
ZAbstractRODataset.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { Abstract Read/Only Dataset component }
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 ZAbstractRODataset;
53 
54 interface
55 
56 {$I ZComponent.inc}
57 
58 uses
59 {$IFNDEF UNIX}
60  Windows,
61 {$ENDIF}
62  Variants,
63  Types, SysUtils, Classes, {$IFDEF MSEgui}mclasses, mdb{$ELSE}DB{$ENDIF},
64  ZSysUtils, ZAbstractConnection, ZDbcIntfs, ZSqlStrings,
65  Contnrs, ZDbcCache, ZDbcCachedResultSet, ZCompatibility, ZExpression
66  {$IFDEF WITH_GENERIC_TLISTTFIELD}, Generics.Collections{$ENDIF};
67 
68 type
69  {$IFDEF xFPC} // fixed in r3943 or earlier 2006-06-25
70  TUpdateStatusSet = set of TUpdateStatus;
71 
72  EUpdateError = class(EDatabaseError)
73  end;
74  {$ENDIF}
75 
76  TSortType = (stAscending, stDescending, stIgnored); {bangfauzan addition}
77 
78  {** Options for dataset. }
79  TZDatasetOption = (doOemTranslate, doCalcDefaults, doAlwaysDetailResync,
80  doSmartOpen, doPreferPrepared, doDontSortOnPost, doUpdateMasterFirst);
81 
82  {** Set of dataset options. }
83  TZDatasetOptions = set of TZDatasetOption;
84 
85  // Forward declarations.
86  TZAbstractRODataset = class;
87 
88  {** Implements a Zeos specific database exception with SQL error code. }
89  EZDatabaseError = class(EDatabaseError)
90  private
91  FErrorCode: Integer;
92  FStatusCode: String;
93  procedure SetStatusCode(const Value: String);
94  public
95  constructor Create(const Msg: string);
96  constructor CreateFromException(E: EZSQLThrowable);
97 
98  property ErrorCode: Integer read FErrorCode write FErrorCode;
99  property StatusCode: String read FStatusCode write SetStatusCode;
100  end;
101 
102  {** Dataset Linker class. }
103  TZDataLink = class(TMasterDataLink)
104  private
105  FDataset: TZAbstractRODataset;
106  protected
107  procedure ActiveChanged; override;
108  procedure RecordChanged(Field: TField); override;
109  public
110  constructor Create(ADataset: TZAbstractRODataset); {$IFDEF FPC}reintroduce;{$ENDIF}
111  end;
112 
113  {** Abstract dataset component optimized for read/only access. }
114  {$IFDEF WITH_WIDEDATASET}
115  TZAbstractRODataset = class(TWideDataSet)
116  {$ELSE}
117  TZAbstractRODataset = class(TDataSet)
118  {$ENDIF}
119  private
120 {$IFNDEF WITH_FUNIDIRECTIONAL}
121  FUniDirectional: Boolean;
122 {$ENDIF}
123  FCurrentRow: Integer;
124  FRowAccessor: TZRowAccessor;
125  FOldRowBuffer: PZRowBuffer;
126  FNewRowBuffer: PZRowBuffer;
127  FCurrentRows: TZSortedList;
128  FFetchCount: Integer;
129  FFieldsLookupTable: TIntegerDynArray;
130  FRowsAffected: Integer;
131 
132  FFilterEnabled: Boolean;
133  FFilterExpression: IZExpression;
134  FFilterStack: TZExecutionStack;
135  FFilterFieldRefs: TObjectDynArray;
136  FInitFilterFields: Boolean;
137 
138  FRequestLive: Boolean;
139  FFetchRow: integer; // added by Patyi
140 
141  FSQL: TZSQLStrings;
142  FParams: TParams;
143  FShowRecordTypes: TUpdateStatusSet;
144  FOptions: TZDatasetOptions;
145 
146  FProperties: TStrings;
147  FConnection: TZAbstractConnection;
148  FStatement: IZPreparedStatement;
149  FResultSet: IZResultSet;
150 
151  FRefreshInProgress: Boolean;
152 
153  FDataLink: TDataLink;
154  FMasterLink: TMasterDataLink;
155  FLinkedFields: string; {renamed by bangfauzan}
156  FIndexFieldNames : String; {bangfauzan addition}
157 
158  FIndexFields: {$IFDEF WITH_GENERIC_TLISTTFIELD}TList<TField>{$ELSE}TList{$ENDIF};
159 
160  FSortType : TSortType; {bangfauzan addition}
161 
162  FSortedFields: string;
163  FSortedFieldRefs: TObjectDynArray;
164  FSortedFieldIndices: TIntegerDynArray;
165  FSortedFieldDirs: TBooleanDynArray;
166  FSortedOnlyDataFields: Boolean;
167  FSortRowBuffer1: PZRowBuffer;
168  FSortRowBuffer2: PZRowBuffer;
169  FPrepared: Boolean;
170  FDoNotCloseResultset: Boolean;
171  FUseCurrentStatment: Boolean;
172  private
173  function GetReadOnly: Boolean;
174  procedure SetReadOnly(Value: Boolean);
175  function GetSQL: TStrings;
176  procedure SetSQL(Value: TStrings);
177  function GetParamCheck: Boolean;
178  procedure SetParamCheck(Value: Boolean);
179  function GetParamChar: Char;
180  procedure SetParamChar(Value: Char);
181  procedure SetParams(Value: TParams);
182  function GetShowRecordTypes: TUpdateStatusSet;
183  procedure SetShowRecordTypes(Value: TUpdateStatusSet);
184  procedure SetConnection(Value: TZAbstractConnection);
185  procedure SetDataSource(Value: TDataSource);
186  function GetMasterFields: string;
187  procedure SetMasterFields(const Value: string);
188  function GetMasterDataSource: TDataSource;
189  procedure SetMasterDataSource(Value: TDataSource);
190  function GetLinkedFields: string; {renamed by bangfauzan}
191  procedure SetLinkedFields(const Value: string); {renamed by bangfauzan}
192  function GetIndexFieldNames : String; {bangfauzan addition}
193  procedure SetIndexFieldNames(Value : String); {bangfauzan addition}
194  procedure SetOptions(Value: TZDatasetOptions);
195  procedure SetSortedFields({const} Value: string); {bangfauzan modification}
196  procedure SetProperties(const Value: TStrings);
197 
198  function GetSortType : TSortType; {bangfauzan addition}
199  Procedure SetSortType(Value : TSortType); {bangfauzan addition}
200 
201  procedure UpdateSQLStrings(Sender: TObject);
202  procedure ReadParamData(Reader: TReader);
203  procedure WriteParamData(Writer: TWriter);
204 
205  procedure SetPrepared(Value : Boolean);
206  {$IFNDEF WITH_FUNIDIRECTIONAL}
207  procedure SetUniDirectional(const Value: boolean);
208  {$ENDIF}
209  function GetUniDirectional: boolean;
210 
211  protected
212  procedure CheckOpened;
213  procedure CheckConnected;
214  procedure CheckBiDirectional;
215  procedure CheckSQLQuery; virtual;
216  procedure RaiseReadOnlyError;
217 
218  function FetchOneRow: Boolean;
219  function FetchRows(RowCount: Integer): Boolean;
220  function FilterRow(RowNo: Integer): Boolean;
221  function GotoRow(RowNo: Integer): Boolean; // added by tohenk
222  procedure RereadRows;
223  procedure SetStatementParams(Statement: IZPreparedStatement;
224  ParamNames: TStringDynArray; Params: TParams;
225  DataLink: TDataLink); virtual;
226  procedure MasterChanged(Sender: TObject);
227  procedure MasterDisabled(Sender: TObject);
228  procedure DoOnNewRecord; override;
229 
230  function GetDataSource: TDataSource; override;
231 
232  protected
233  { Internal protected properties. }
234  property RowAccessor: TZRowAccessor read FRowAccessor write FRowAccessor;
235  property CurrentRow: Integer read FCurrentRow write FCurrentRow;
236  property OldRowBuffer: PZRowBuffer read FOldRowBuffer write FOldRowBuffer;
237  property NewRowBuffer: PZRowBuffer read FNewRowBuffer write FNewRowBuffer;
238  property CurrentRows: TZSortedList read FCurrentRows write FCurrentRows;
239  property FetchCount: Integer read FFetchCount write FFetchCount;
240  property FieldsLookupTable: TIntegerDynArray read FFieldsLookupTable
241  write FFieldsLookupTable;
242 
243  property FilterEnabled: Boolean read FFilterEnabled write FFilterEnabled;
244  property FilterExpression: IZExpression read FFilterExpression
245  write FFilterExpression;
246  property FilterStack: TZExecutionStack read FFilterStack write FFilterStack;
247  property FilterFieldRefs: TObjectDynArray read FFilterFieldRefs
248  write FFilterFieldRefs;
249  property InitFilterFields: Boolean read FInitFilterFields
250  write FInitFilterFields;
251 
252  property Statement: IZPreparedStatement read FStatement write FStatement;
253  property ResultSet: IZResultSet read FResultSet write FResultSet;
254 
255  property DataLink: TDataLink read FDataLink;
256  property MasterLink: TMasterDataLink read FMasterLink;
257  property IndexFields: {$IFDEF WITH_GENERIC_TLISTTFIELD}TList<TField>{$ELSE}TList{$ENDIF} read FIndexFields;
258 
259  { External protected properties. }
260  property RequestLive: Boolean read FRequestLive write FRequestLive
261  default False;
262  property FetchRow: integer read FFetchRow write FFetchRow default 0; // added by Patyi
263  property SQL: TStrings read GetSQL write SetSQL;
264  property ParamCheck: Boolean read GetParamCheck write SetParamCheck
265  default True;
266  property ParamChar: Char read GetParamChar write SetParamChar
267  default ':';
268  property Params: TParams read FParams write SetParams;
269  property ReadOnly: Boolean read GetReadOnly write SetReadOnly default True;
270  property ShowRecordTypes: TUpdateStatusSet read GetShowRecordTypes
271  write SetShowRecordTypes default [usUnmodified, usModified, usInserted];
272  property IsUniDirectional: Boolean read GetUniDirectional
273  write SetUniDirectional default False;
274  property Properties: TStrings read FProperties write SetProperties;
275  property Options: TZDatasetOptions read FOptions write SetOptions
276  default [doCalcDefaults];
277  property DataSource: TDataSource read GetDataSource write SetDataSource;
278  property MasterFields: string read GetMasterFields
279  write SetMasterFields;
280  property MasterSource: TDataSource read GetMasterDataSource
281  write SetMasterDataSource;
282  property LinkedFields: string read GetLinkedFields
283  write SetLinkedFields; {renamed by bangfauzan}
284  property IndexFieldNames:String read GetIndexFieldNames
285  write SetIndexFieldNames; {bangfauzan addition}
286  property DoNotCloseResultset: Boolean read FDoNotCloseResultset;
287  protected
288  { Abstracts methods }
289  procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
290  procedure InternalDelete; override;
291  procedure InternalPost; override;
292 
293  procedure SetFieldData(Field: TField; Buffer: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF};
294  NativeFormat: Boolean); override;
295  procedure SetFieldData(Field: TField; Buffer: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF}); override;
296  procedure DefineProperties(Filer: TFiler); override;
297 
298 {$IFDEF WITH_TRECORDBUFFER}
299  function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean):
300  TGetResult; override;
301 {$ELSE}
302  function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean):
303  TGetResult; override;
304 {$ENDIF}
305  function GetRecordSize: Word; override;
306  function GetActiveBuffer(var RowBuffer: PZRowBuffer): Boolean;
307 {$IFDEF WITH_TRECORDBUFFER}
308  function AllocRecordBuffer: TRecordBuffer; override;
309  procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
310 {$ELSE}
311  function AllocRecordBuffer: PChar; override;
312  procedure FreeRecordBuffer(var Buffer: PChar); override;
313 {$ENDIF}
314 {$IFDEF WITH_FTDATASETSUPPORT}
315  function CreateNestedDataSet(DataSetField: TDataSetField): TDataSet; override;
316 {$ENDIF}
317  procedure CloseBlob(Field: TField); override;
318  function CreateStatement(const SQL: string; Properties: TStrings):
319  IZPreparedStatement; virtual;
320  function CreateResultSet(const SQL: string; MaxRows: Integer):
321  IZResultSet; virtual;
322 
323  procedure CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef); {$IFDEF WITH_CHECKFIELDCOMPATIBILITY} override;{$ENDIF}
324 {$IFDEF WITH_TRECORDBUFFER}
325  procedure ClearCalcFields(Buffer: TRecordBuffer); override;
326 {$ELSE}
327  procedure ClearCalcFields(Buffer: PChar); override;
328 {$ENDIF}
329 
330  procedure InternalInitFieldDefs; override;
331  procedure InternalOpen; override;
332  procedure InternalClose; override;
333  procedure InternalFirst; override;
334  procedure InternalLast; override;
335 {$IFDEF WITH_TRECORDBUFFER}
336  procedure InternalInitRecord(Buffer: TRecordBuffer); override;
337 {$ELSE}
338  procedure InternalInitRecord(Buffer: PChar); override;
339 {$ENDIF}
340  procedure InternalGotoBookmark(Bookmark: Pointer); override;
341  procedure InternalRefresh; override;
342  procedure InternalHandleException; override;
343 {$IFDEF WITH_TRECORDBUFFER}
344  procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
345 
346  procedure GetBookmarkData(Buffer: TRecordBuffer;
347  Data:{$IFDEF WITH_BOOKMARKDATA_TBOOKMARK}TBookMark{$ELSE}Pointer{$ENDIF}); override;
348  function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
349  procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
350  procedure SetBookmarkData(Buffer: TRecordBuffer;
351  Data: {$IFDEF WITH_BOOKMARKDATA_TBOOKMARK}TBookMark{$ELSE}Pointer{$ENDIF}); override;
352 {$ELSE}
353  procedure InternalSetToRecord(Buffer: PChar); override;
354 
355  procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
356  function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
357  procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
358  procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
359 {$ENDIF}
360  function InternalLocate(const KeyFields: string; const KeyValues: Variant;
361  Options: TLocateOptions): LongInt;
362  function FindRecord(Restart, GoForward: Boolean): Boolean; override;
363  procedure SetFiltered(Value: Boolean); override;
364  procedure SetFilterText(const Value: string); override;
365 
366  procedure SetAnotherResultset(const Value: IZResultSet);
367  procedure InternalSort;
368  function ClearSort(Item1, Item2: Pointer): Integer;
369  function HighLevelSort(Item1, Item2: Pointer): Integer;
370  function LowLevelSort(Item1, Item2: Pointer): Integer;
371 
372  function GetCanModify: Boolean; override;
373  function GetRecNo: Integer; override;
374  function GetRecordCount: Integer; override;
375  procedure MoveRecNo(Value: Integer);
376  procedure SetRecNo(Value: Integer); override;
377  function IsCursorOpen: Boolean; override;
378 
379  procedure Notification(AComponent: TComponent;
380  Operation: TOperation); override;
381 
382  procedure RefreshParams; virtual;
383 
384  procedure InternalPrepare; virtual;
385  procedure InternalUnPrepare; virtual;
386  protected
387  {$IFDEF WITH_IPROVIDER}
388  procedure PSStartTransaction; override;
389  procedure PSEndTransaction(Commit: Boolean); override;
390  // Silvio Clecio
391  {$IFDEF WITH_IPROVIDERWIDE}
392  function PSGetTableNameW: WideString; override;
393  function PSGetQuoteCharW: WideString; override;
394  function PSGetKeyFieldsW: WideString; override;
395  procedure PSSetCommandText(const CommandText: WideString); overload; override;
396  procedure PSSetCommandText(const CommandText: string); overload; override;
397  //?? function PSGetCommandTextW: WideString; override;
398  function PSExecuteStatement(const ASQL: WideString; AParams: TParams;
399  ResultSet: Pointer = nil): Integer; override;
400  {$ELSE}
401  function PSGetTableName: string; override;
402  function PSGetQuoteChar: string; override;
403  function PSGetKeyFields: string; override;
404  function PSExecuteStatement(const ASQL: string; AParams: TParams;
405  ResultSet: Pointer = nil): Integer; override;
406  procedure PSSetCommandText(const CommandText: string); override;
407  {$ENDIF}
408  function PSGetUpdateException(E: Exception;
409  Prev: EUpdateError): EUpdateError; override;
410  function PSIsSQLBased: Boolean; override;
411  function PSIsSQLSupported: Boolean; override;
412  procedure PSReset; override;
413  function PSUpdateRecord(UpdateKind: TUpdateKind;
414  Delta: TDataSet): Boolean; override;
415  procedure PSExecute; override;
416  function PSGetParams: TParams; override;
417  procedure PSSetParams(AParams: TParams); override;
418  function PSInTransaction: Boolean; override;
419  {$ENDIF}
420 
421  public
422  constructor Create(AOwner: TComponent); override;
423  destructor Destroy; override;
424 
425  procedure FetchAll; virtual; // added by Patyi
426  procedure ExecSQL; virtual;
427  function RowsAffected: LongInt;
428  function ParamByName(const Value: string): TParam;
429 
430  function Locate(const KeyFields: string; const KeyValues: Variant;
431  Options: TLocateOptions): Boolean; override;
432  function Lookup(const KeyFields: string; const KeyValues: Variant;
433  const ResultFields: string): Variant; override;
434  function IsSequenced: Boolean; override;
435 
436  function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
437  override;
438  function BookmarkValid(Bookmark: TBookmark): Boolean; override;
439 
440  function GetFieldData(Field: TField; {$IFDEF WITH_VAR_TVALUEBUFFER}var{$ENDIF}Buffer: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF}): Boolean; override;
441  function GetFieldData(Field: TField; {$IFDEF WITH_VAR_TVALUEBUFFER}var{$ENDIF}Buffer: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF};
442  NativeFormat: Boolean): Boolean; override;
443  function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
444  override;
445  function UpdateStatus: TUpdateStatus; override;
446  function Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; override;
447  procedure Prepare;
448  procedure Unprepare;
449 
450  public
451  property Active;
452  property Prepared: Boolean read FPrepared write SetPrepared;
453  property FieldDefs stored False;
454  property DbcStatement: IZPreparedStatement read FStatement;
455  property DbcResultSet: IZResultSet read FResultSet;
456 
457  published
458  property Connection: TZAbstractConnection read FConnection write SetConnection;
459  property SortedFields: string read FSortedFields write SetSortedFields;
460  property SortType : TSortType read FSortType write SetSortType
461  default stAscending; {bangfauzan addition}
462 
463  property AutoCalcFields;
464  property BeforeOpen;
465  property AfterOpen;
466  property BeforeClose;
467  property AfterClose;
468  property BeforeRefresh;
469  property AfterRefresh;
470  property BeforeScroll;
471  property AfterScroll;
472  property OnCalcFields;
473  property OnFilterRecord;
474  property Filter;
475  property Filtered;
476  end;
477 
478 implementation
479 
480 uses Math, ZVariant, ZMessages, ZDatasetUtils, ZStreamBlob, ZSelectSchema,
481  ZGenericSqlToken, ZTokenizer, ZGenericSqlAnalyser, ZAbstractDataset
482  {$IFDEF WITH_DBCONSTS}, DBConsts {$ELSE}, DBConst{$ENDIF}
483  {$IFDEF WITH_WIDESTRUTILS}, WideStrUtils{$ENDIF}
484  {$IFDEF WITH_UNITANSISTRINGS}, AnsiStrings{$ENDIF};
485 
486 { EZDatabaseError }
487 
488 {**
489  Constructs a database exception with a string message.
490  @param Msg a string message which describes the error.
491 }
492 constructor EZDatabaseError.Create(const Msg: string);
493 begin
494  inherited Create(Msg);
495 end;
496 
497 {**
498  Constructs a database exception from TZSQLThrowable instance.
499  @param E an original TZSQLThrowable instance.
500 }
501 constructor EZDatabaseError.CreateFromException(E: EZSQLThrowable);
502 begin
503  inherited Create(E.Message);
504  ErrorCode := E.ErrorCode;
505  Statuscode:= E.StatusCode;
506 end;
507 
508 procedure EZDatabaseError.SetStatusCode(const Value: String);
509 begin
510  FStatusCode := value;
511 end;
512 
513 { TZDataLink }
514 
515 {**
516  Creates this dataset link object.
517  @param ADataset an owner linked dataset component.
518 }
519 constructor TZDataLink.Create(ADataset: TZAbstractRODataset);
520 begin
521  inherited Create(ADataset);
522  FDataset := ADataset;
523 end;
524 
525 {**
526  Processes changes in state of linked dataset.
527 }
528 procedure TZDataLink.ActiveChanged;
529 begin
530  if FDataset.Active then
531  FDataset.RefreshParams;
532 end;
533 
534 {**
535  Processes changes in fields of the linked dataset.
536  @param Field a field which was changed.
537 }
538 procedure TZDataLink.RecordChanged(Field: TField);
539 begin
540  if (Field = nil) and FDataset.Active then
541  FDataset.RefreshParams;
542 end;
543 
544 { TZAbstractRODataset }
545 
546 {**
547  Constructs this object and assignes the mail properties.
548  @param AOwner a component owner.
549 }
550 constructor TZAbstractRODataset.Create(AOwner: TComponent);
551 begin
552  inherited Create(AOwner);
553 
554  FSQL := TZSQLStrings.Create;
555  TZSQLStrings(FSQL).Dataset := Self;
556  TZSQLStrings(FSQL).MultiStatements := False;
557  FSQL.OnChange := UpdateSQLStrings;
558  FParams := TParams.Create(Self);
559  FCurrentRows := TZSortedList.Create;
560  BookmarkSize := SizeOf(Integer);
561  FShowRecordTypes := [usModified, usInserted, usUnmodified];
562  FRequestLive := False;
563  FFetchRow := 0; // added by Patyi
564  FOptions := [doCalcDefaults];
565 
566  FFilterEnabled := False;
567  FProperties := TStringList.Create;
568  FFilterExpression := TZExpression.Create;
569  FFilterExpression.Tokenizer := CommonTokenizer;
570  FFilterStack := TZExecutionStack.Create;
571 
572  FDataLink := TZDataLink.Create(Self);
573  FMasterLink := TMasterDataLink.Create(Self);
574  FMasterLink.OnMasterChange := MasterChanged;
575  FMasterLink.OnMasterDisable := MasterDisabled;
576  {$IFDEF WITH_GENERIC_TLISTTFIELD}
577  FIndexFields := TList<TField>.Create;
578  {$ELSE}
579  FIndexFields := TList.Create;
580  {$ENDIF}
581 end;
582 
583 {**
584  Destroys this object and cleanups the memory.
585 }
586 destructor TZAbstractRODataset.Destroy;
587 begin
588  Unprepare;
589  if Assigned(Connection) then
590  begin
591  try
592  SetConnection(nil);
593  except
594  end;
595  end;
596 
597  FreeAndNil(FSQL);
598  FreeAndNil(FParams);
599  FreeAndNil(FCurrentRows);
600  FreeAndNil(FProperties);
601  FreeAndNil(FFilterStack);
602 
603  FreeAndNil(FDataLink);
604  FreeAndNil(FMasterLink);
605  FreeAndNil(FIndexFields);
606 
607  inherited Destroy;
608 end;
609 
610 {**
611  Sets database connection object.
612  @param Value a database connection object.
613 }
614 procedure TZAbstractRODataset.SetConnection(Value: TZAbstractConnection);
615 begin
616  if FConnection <> Value then
617  begin
618  if Active then
619  Close;
620  Unprepare;
621  if FConnection <> nil then
622  FConnection.UnregisterDataSet(Self);
623  FConnection := Value;
624  if FConnection <> nil then
625  FConnection.RegisterDataSet(Self);
626  end;
627 end;
628 
629 {**
630  Gets the SQL query.
631  @return the SQL query strings.
632 }
633 
634 function TZAbstractRODataset.GetSQL: TStrings;
635 begin
636  Result := FSQL;
637 end;
638 
639 {$IFNDEF WITH_FUNIDIRECTIONAL}
640 function TZAbstractRODataset.SetUniDirectional(const Value: boolean);
641 begin
642  FUniDirectional := Value;
643 end;
644 {$ENDIF}
645 {**
646  Gets unidirectional state of dataset.
647  @return the unidirectional flag (delphi).
648 }
649 function TZAbstractRODataset.GetUniDirectional: boolean;
650 begin
651  Result := {$IFNDEF WITH_FUNIDIRECTIONAL}FUniDirectional{$ELSE}inherited IsUniDirectional{$ENDIF};
652 end;
653 
654 {**
655  Sets a new SQL query.
656  @param Value a new SQL query.
657 }
658 procedure TZAbstractRODataset.SetSQL(Value: TStrings);
659 begin
660  FSQL.Assign(Value);
661 end;
662 
663 {**
664  Gets a parameters check value.
665  @return a parameters check value.
666 }
667 function TZAbstractRODataset.GetParamCheck: Boolean;
668 begin
669  Result := FSQL.ParamCheck;
670 end;
671 
672 {**
673  Sets a new parameters check value.
674  @param Value a parameters check value.
675 }
676 procedure TZAbstractRODataset.SetParamCheck(Value: Boolean);
677 begin
678  FSQL.ParamCheck := Value;
679  UpdateSQLStrings(Self);
680 end;
681 
682 {**
683  Gets a parameters marker.
684  @return a parameter marker.
685 }
686 function TZAbstractRODataset.GetParamChar: Char;
687 begin
688  Result := FSQL.ParamChar;
689 end;
690 
691 {**
692  Sets a new parameter marker.
693  @param Value a parameter marker.
694 }
695 procedure TZAbstractRODataset.SetParamChar(Value: Char);
696 begin
697  FSQL.ParamChar := Value;
698  UpdateSQLStrings(Self);
699 end;
700 
701 {**
702  Sets a new set of parameters.
703  @param Value a set of parameters.
704 }
705 procedure TZAbstractRODataset.SetParams(Value: TParams);
706 begin
707  FParams.AssignValues(Value);
708 end;
709 
710 {**
711  Defines a persistent dataset properties.
712  @param Filer a persistent manager object.
713 }
714 procedure TZAbstractRODataset.DefineProperties(Filer: TFiler);
715 
716  function WriteData: Boolean;
717  begin
718  if Filer.Ancestor <> nil then
719  Result := not FParams.IsEqual(TZAbstractRODataset(Filer.Ancestor).FParams)
720  else
721  Result := FParams.Count > 0;
722  end;
723 
724 begin
725  inherited DefineProperties(Filer);
726  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
727 end;
728 
729 {**
730  Reads parameter data from persistent storage.
731  @param Reader an input data stream.
732 }
733 procedure TZAbstractRODataset.ReadParamData(Reader: TReader);
734 begin
735  Reader.ReadValue;
736  Reader.ReadCollection(FParams);
737 end;
738 
739 {**
740  Writes parameter data from persistent storage.
741  @param Writer an output data stream.
742 }
743 procedure TZAbstractRODataset.WriteParamData(Writer: TWriter);
744 begin
745  Writer.WriteCollection(Params);
746 end;
747 
748 {**
749  Gets a SQL parameter by its name.
750  @param Value a parameter name.
751  @return a found parameter object.
752 }
753 function TZAbstractRODataset.ParamByName(const Value: string): TParam;
754 begin
755  Result := FParams.ParamByName(Value);
756 end;
757 
758 {**
759  Updates parameters from SQL statement.
760  @param Sender an event sender object.
761 }
762 procedure TZAbstractRODataset.UpdateSQLStrings(Sender: TObject);
763 var
764  I: Integer;
765  OldParams: TParams;
766 begin
767  FieldDefs.Clear;
768  if Active then
769  Close
770  else
771  begin
772  if assigned(Statement) then
773  Statement.Close;
774  Statement := nil;
775  end;
776 
777  UnPrepare;
778 
779  OldParams := TParams.Create;
780  OldParams.Assign(FParams);
781  FParams.Clear;
782 
783  try
784  for I := 0 to FSQL.ParamCount - 1 do
785  FParams.CreateParam(ftUnknown, FSQL.ParamNames[I], ptUnknown);
786  FParams.AssignValues(OldParams);
787  finally
788  OldParams.Free;
789  end;
790 end;
791 
792 {**
793  Gets the ReadOnly property.
794  @return <code>True</code> if the opened result set read only.
795 }
796 function TZAbstractRODataset.GetReadOnly: Boolean;
797 begin
798  Result := not RequestLive;
799 end;
800 
801 {**
802  Sets a new ReadOnly property.
803  @param Value <code>True</code> to set result set read-only.
804 }
805 procedure TZAbstractRODataset.SetReadOnly(Value: Boolean);
806 begin
807  RequestLive := not Value;
808 end;
809 
810 {**
811  Gets a visible updated records types.
812  @param return visible UpdateRecordTypes value.
813 }
814 function TZAbstractRODataset.GetShowRecordTypes: TUpdateStatusSet;
815 begin
816  Result := FShowRecordTypes;
817 end;
818 
819 {**
820  Sets a new visible updated records types.
821  @param Value a new visible UpdateRecordTypes value.
822 }
823 procedure TZAbstractRODataset.SetShowRecordTypes(Value: TUpdateStatusSet);
824 begin
825  if Value <> FShowRecordTypes then
826  begin
827  FShowRecordTypes := Value;
828  RereadRows;
829  end;
830 end;
831 
832 {**
833  Checks if this dataset is opened.
834 }
835 procedure TZAbstractRODataset.CheckOpened;
836 begin
837  if not Active then
838  DatabaseError(SOperationIsNotAllowed4);
839 end;
840 
841 {**
842  Checks if the database connection is assigned
843  and tries to connect.
844 }
845 procedure TZAbstractRODataset.CheckConnected;
846 begin
847  if Connection = nil then
848  raise EZDatabaseError.Create(SConnectionIsNotAssigned);
849  Connection.Connect;
850 end;
851 
852 {**
853  Checks is the database has bidirectional access.
854 }
855 procedure TZAbstractRODataset.CheckBiDirectional;
856 begin
857  if IsUniDirectional then
858  raise EZDatabaseError.Create(SOperationIsNotAllowed1);
859 end;
860 
861 {**
862  Checks the correct SQL query.
863 }
864 procedure TZAbstractRODataset.CheckSQLQuery;
865 begin
866  if FSQL.StatementCount < 1 then
867  raise EZDatabaseError.Create(SQueryIsEmpty);
868  if FSQL.StatementCount > 1 then
869  raise EZDatabaseError.Create(SCanNotExecuteMoreQueries);
870 end;
871 
872 {**
873  Raises an error 'Operation is not allowed in read-only dataset.
874 }
875 procedure TZAbstractRODataset.RaiseReadOnlyError;
876 begin
877  raise EZDatabaseError.Create(SOperationIsNotAllowed2);
878 end;
879 
880 {**
881  Fetches specified number of records.
882  @param RowCount a specified number of rows to be fetched.
883  @return <code>True</code> if all required rows were fetched.
884 }
885 function TZAbstractRODataset.FetchRows(RowCount: Integer): Boolean;
886 begin
887  Connection.ShowSQLHourGlass;
888  try
889  if RowCount = 0 then
890  begin
891  while FetchOneRow do;
892  Result := True;
893  end
894  else
895  begin
896  while (CurrentRows.Count < RowCount) do
897  begin
898  if not FetchOneRow then
899  Break;
900  end;
901  Result := CurrentRows.Count >= RowCount;
902  end;
903  finally
904  Connection.HideSQLHourGlass;
905  end;
906 end;
907 
908 {**
909  Fetches one row from the result set.
910  @return <code>True</code> if record was successfully fetched.
911 }
912 function TZAbstractRODataset.FetchOneRow: Boolean;
913 begin
914  if Assigned(ResultSet) then
915  repeat
916  if (FetchCount = 0) or (ResultSet.GetRow = FetchCount)
917  or ResultSet.MoveAbsolute(FetchCount) then
918  Result := ResultSet.Next
919  else
920  Result := False;
921  if Result then
922  begin
923  Inc(FFetchCount);
924  if FilterRow(ResultSet.GetRow) then
925  CurrentRows.Add(Pointer(ResultSet.GetRow))
926  else
927  Continue;
928  end;
929  until True
930  else
931  Result := False;
932 end;
933 
934 {**
935  Checks the specified row with the all filters.
936  @param RowNo a number of the row.
937  @return <code>True</code> if the row sutisfy to all filters.
938 }
939 function TZAbstractRODataset.FilterRow(RowNo: Integer): Boolean;
940 var
941  I: Integer;
942  SavedRow: Integer;
943  SavedRows: TZSortedList;
944  SavedState: TDatasetState;
945 begin
946  Result := True;
947 
948  { Locates the result set to the specified row. }
949  if ResultSet.GetRow <> RowNo then
950  begin
951  if not ResultSet.MoveAbsolute(RowNo) then
952  Result := False;
953  end;
954  if not Result then
955  Exit;
956 
957  { Checks record by ShowRecordType }
958  if ResultSet.RowUpdated then
959  Result := usModified in ShowRecordTypes
960  else if ResultSet.RowInserted then
961  Result := usInserted in ShowRecordTypes
962  else if ResultSet.RowDeleted then
963  Result := usDeleted in ShowRecordTypes
964  else
965  Result := usUnmodified in ShowRecordTypes;
966  if not Result then
967  Exit;
968 
969  { Check master-detail links }
970  if MasterLink.Active then
971  begin
972  for I := 0 to MasterLink.Fields.Count - 1 do
973  begin
974  if I < IndexFields.Count then
975  Result := CompareKeyFields(TField(IndexFields[I]), ResultSet,
976  TField(MasterLink.Fields[I]));
977 
978  if not Result then
979  Break;
980  end;
981  end;
982  if not Result then
983  Exit;
984 
985  { Checks record by OnFilterRecord event }
986  if FilterEnabled and Assigned(OnFilterRecord) then
987  begin
988  SavedRow := CurrentRow;
989  SavedRows := CurrentRows;
990  CurrentRows := TZSortedList.Create;
991 
992  SavedState := SetTempState(dsNewValue);
993  CurrentRows.Add(Pointer(RowNo));
994  CurrentRow := 1;
995 
996  try
997  OnFilterRecord(Self, Result);
998  except
999  if Assigned(ApplicationHandleException)
1000  then ApplicationHandleException(Self);
1001  end;
1002 
1003  CurrentRow := SavedRow;
1004  CurrentRows.Free;
1005  CurrentRows := SavedRows;
1006  RestoreState(SavedState);
1007 
1008  end;
1009  if not Result then
1010  Exit;
1011 
1012  { Check the record by filter expression. }
1013  if FilterEnabled and (FilterExpression.Expression <> '') then
1014  begin
1015  if not InitFilterFields then
1016  begin
1017  FilterFieldRefs := DefineFilterFields(Self, FilterExpression);
1018  InitFilterFields := True;
1019  end;
1020  CopyDataFieldsToVars(FilterFieldRefs, ResultSet,
1021  FilterExpression.DefaultVariables);
1022  Result := FilterExpression.VariantManager.GetAsBoolean(
1023  FilterExpression.Evaluate4(FilterExpression.DefaultVariables,
1024  FilterExpression.DefaultFunctions, FilterStack));
1025  end;
1026  if not Result then
1027  Exit;
1028 end;
1029 
1030 {**
1031  Go to specified row.
1032  @param RowNo a number of the row.
1033  @return <code>True</code> if the row successfully located.
1034 }
1035 function TZAbstractRODataset.GotoRow(RowNo: Integer): Boolean;
1036 var
1037  Index: Integer;
1038 begin
1039  Result := False;
1040  Index := CurrentRows.IndexOf(Pointer(RowNo));
1041  if Index >= 0 then
1042  begin
1043  if Index < CurrentRow then
1044  CheckBiDirectional;
1045  CurrentRow := Index + 1;
1046  Result := True;
1047  end;
1048 end;
1049 
1050 {**
1051  Rereads all rows and applies a filter.
1052 }
1053 procedure TZAbstractRODataset.RereadRows;
1054 var
1055  I, RowNo: Integer;
1056 begin
1057  if not (State in [dsInactive]) and not IsUniDirectional then
1058  begin
1059  if (CurrentRow > 0) and (CurrentRow <= CurrentRows.Count) and
1060  (CurrentRows.Count > 0) then
1061  RowNo := Integer(CurrentRows[CurrentRow - 1])
1062  else
1063  RowNo := -1;
1064  CurrentRows.Clear;
1065 
1066  for I := 1 to FetchCount do
1067  begin
1068  if FilterRow(I) then
1069  CurrentRows.Add(Pointer(I));
1070  end;
1071 
1072  CurrentRow := CurrentRows.IndexOf(Pointer(RowNo)) + 1;
1073  CurrentRow := Min(Max(1, CurrentRow), CurrentRows.Count);
1074 
1075  if FSortedFields <> '' then
1076  InternalSort
1077  else
1078  Resync([]);
1079  end;
1080 end;
1081 
1082 {**
1083  Fill prepared statement with parameters.
1084  @param Statement a prepared SQL statement.
1085  @param ParamNames an array of parameter names.
1086  @param Params a collection of SQL parameters.
1087  @param DataLink a datalink to get parameters.
1088 }
1089 procedure TZAbstractRODataset.SetStatementParams(Statement: IZPreparedStatement;
1090  ParamNames: TStringDynArray; Params: TParams; DataLink: TDataLink);
1091 var
1092  I: Integer;
1093  TempParam, Param: TParam;
1094  Dataset: TDataset;
1095  Field: TField;
1096 begin
1097  if DataLink.Active then
1098  Dataset := DataLink.DataSet
1099  else
1100  Dataset := nil;
1101 
1102  TempParam := TParam.Create(nil);
1103 
1104  try
1105  for I := Low(ParamNames) to High(ParamNames) do
1106  begin
1107  if Assigned(Dataset) then
1108  Field := Dataset.FindField(ParamNames[I])
1109  else
1110  Field := nil;
1111 
1112  if Assigned(Field) then
1113  begin
1114  TempParam.AssignField(Field);
1115  Param := TempParam;
1116  end
1117  else
1118  begin
1119  Param := Params.FindParam(ParamNames[I]);
1120  if not Assigned(Param) or (Param.ParamType in [ptOutput, ptResult]) then
1121  Continue;
1122  end;
1123 
1124  SetStatementParam(I+ 1, Statement, Param);
1125  end;
1126  finally
1127  TempParam.Free;
1128  end;
1129 end;
1130 
1131 {**
1132  Locates a specified record in dataset.
1133  @param Buffer a record buffer to put the contents of the row.
1134  @param GetMode a location mode.
1135  @param DoCheck flag to perform checking.
1136  @return a location result.
1137 }
1138 
1139 {$IFDEF WITH_TRECORDBUFFER}
1140 function TZAbstractRODataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
1141  DoCheck: Boolean): TGetResult;
1142 {$ELSE}
1143 
1144 function TZAbstractRODataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
1145  DoCheck: Boolean): TGetResult;
1146 {$ENDIF}
1147 var
1148  RowNo: Integer;
1149 begin
1150  // mad stub for unidirectional (problem in TDataSet.MoveBuffer) - dont know about FPC
1151  // we always use same TDataSet-level buffer, because we can see only one row
1152  {$IFNDEF WITH_UNIDIRECTIONALBUG}
1153  if IsUniDirectional then
1154  Buffer := {$IFDEF WITH_BUFFERS_IS_TRECBUF}Pointer{$ENDIF}(Buffers[0]);
1155  {$ENDIF}
1156 
1157  Result := grOK;
1158  case GetMode of
1159  gmNext:
1160  begin
1161  if FetchRows(CurrentRow + 1) then
1162  CurrentRow := CurrentRow + 1
1163  else
1164  Result := grEOF;
1165  end;
1166  gmPrior:
1167  begin
1168  CheckBiDirectional;
1169  if (CurrentRow > 1) and (CurrentRows.Count > 0) then
1170  CurrentRow := CurrentRow - 1
1171  else
1172  Result := grBOF;
1173  end;
1174  gmCurrent:
1175  begin
1176  if CurrentRow < CurrentRows.Count then
1177  CheckBiDirectional;
1178 
1179  if CurrentRow = 0 then
1180  begin
1181  if CurrentRows.Count = 0 then
1182  FetchRows(1);
1183  CurrentRow := Min(CurrentRows.Count, 1);
1184  end
1185  else if not FetchRows(CurrentRow) then
1186  CurrentRow := Max(1, Min(CurrentRows.Count, CurrentRow));
1187 
1188  if CurrentRows.Count = 0 then
1189  Result := grError;
1190  end;
1191  end;
1192 
1193  if Result = grOK then
1194  begin
1195  RowNo := Integer(CurrentRows[CurrentRow - 1]);
1196  if ResultSet.GetRow <> RowNo then
1197  ResultSet.MoveAbsolute(RowNo);
1198  RowAccessor.RowBuffer := PZRowBuffer(Buffer);
1199  RowAccessor.RowBuffer^.Index := RowNo;
1200  FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
1201  FRowAccessor.RowBuffer^.BookmarkFlag := Ord(bfCurrent);
1202  GetCalcFields({$IFDEF WITH_GETCALCFIELDS_TRECBUF}NativeInt{$ENDIF}(Buffer));
1203  end;
1204 
1205  if (Result = grError) and DoCheck then
1206  raise EZDatabaseError.Create(SNoMoreRecords);
1207 end;
1208 
1209 {**
1210  Gets the current record buffer depended on the current dataset state.
1211  @param RowBuffer a reference to the result row buffer.
1212  @return <code>True</code> if the buffer was defined.
1213 }
1214 function TZAbstractRODataset.GetActiveBuffer(var RowBuffer: PZRowBuffer):
1215  Boolean;
1216 var
1217  RowNo: Integer;
1218  CachedResultSet: IZCachedResultSet;
1219 begin
1220  RowBuffer := nil;
1221  case State of
1222  dsBrowse,dsblockread:
1223  if not IsEmpty then
1224  RowBuffer := PZRowBuffer(ActiveBuffer);
1225  dsEdit, dsInsert:
1226  RowBuffer := PZRowBuffer(ActiveBuffer);
1227  dsCalcFields:
1228  RowBuffer := PZRowBuffer(CalcBuffer);
1229  dsOldValue, dsNewValue, dsCurValue:
1230  begin
1231  RowNo := Integer(CurrentRows[CurrentRow - 1]);
1232  if RowNo <> ResultSet.GetRow then
1233  CheckBiDirectional;
1234 
1235  if State = dsOldValue then
1236  RowBuffer := OldRowBuffer
1237  else
1238  RowBuffer := NewRowBuffer;
1239 
1240  if RowBuffer.Index <> RowNo then
1241  begin
1242  RowAccessor.RowBuffer := RowBuffer;
1243  RowAccessor.Clear;
1244  if (ResultSet.GetRow = RowNo) or ResultSet.MoveAbsolute(RowNo) then
1245  begin
1246  if (State = dsOldValue) and (ResultSet.
1247  QueryInterface(IZCachedResultSet, CachedResultSet) = 0) then
1248  CachedResultSet.MoveToInitialRow;
1249  FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
1250  RowBuffer.Index := RowNo;
1251  ResultSet.MoveToCurrentRow;
1252  end
1253  else
1254  RowBuffer := nil;
1255  end;
1256  end;
1257  end;
1258  Result := RowBuffer <> nil;
1259 end;
1260 
1261 function TZAbstractRODataset.GetFieldData(Field: TField;
1262  {$IFDEF WITH_VAR_TVALUEBUFFER}var{$ENDIF}Buffer:
1263  {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF};
1264  NativeFormat: Boolean): Boolean;
1265 begin
1266  if Field.DataType in [ftWideString] then
1267  NativeFormat := True;
1268  Result := inherited GetFieldData(Field, Buffer, NativeFormat);
1269 end;
1270 
1271 {**
1272  Retrieves the column value and stores it into the field buffer.
1273  @param Field an field object to be retrieved.
1274  @param Buffer a field value buffer.
1275  @return <code>True</code> if non-null value was retrieved.
1276 }
1277 function TZAbstractRODataset.GetFieldData(Field: TField;
1278  {$IFDEF WITH_VAR_TVALUEBUFFER}var{$ENDIF}Buffer:
1279  {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF}): Boolean;
1280 var
1281  ColumnIndex: Integer;
1282  RowBuffer: PZRowBuffer;
1283  ACurrency: Double;
1284  Bts: TByteDynArray;
1285  {$IFNDEF WITH_WIDESTRUTILS}
1286  WS: WideString;
1287  {$ENDIF}
1288 begin
1289  if GetActiveBuffer(RowBuffer) then
1290  begin
1291  ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
1292  RowAccessor.RowBuffer := RowBuffer;
1293  if Buffer <> nil then
1294  begin
1295  case Field.DataType of
1296  { Processes DateTime fields. }
1297  ftDate, ftTime, ftDateTime:
1298  begin
1299  if Field.DataType <> ftTime then
1300  DateTimeToNative(Field.DataType,
1301  RowAccessor.GetTimestamp(ColumnIndex, Result), Buffer)
1302  else
1303  DateTimeToNative(Field.DataType,
1304  RowAccessor.GetTime(ColumnIndex, Result), Buffer);
1305  Result := not Result;
1306  end;
1307  { Processes binary array fields. }
1308  ftBytes:
1309  begin
1310  Bts := RowAccessor.GetBytes(ColumnIndex, Result);
1311  System.Move(PAnsiChar(Bts)^,
1312  PAnsiChar(Buffer)^, Min(Length(Bts), RowAccessor.GetColumnDataSize(ColumnIndex)));
1313  Result := not Result;
1314  end;
1315  { Processes blob fields. }
1316  ftBlob, ftMemo, ftGraphic, ftFmtMemo {$IFDEF WITH_WIDEMEMO},ftWideMemo{$ENDIF} :
1317  Result := not RowAccessor.GetBlob(ColumnIndex, Result).IsEmpty;
1318  ftWideString:
1319  begin
1320  {$IFDEF WITH_WIDESTRUTILS}
1321  WStrCopy(PWideChar(Buffer), PWideChar(RowAccessor.GetUnicodeString(ColumnIndex, Result)));
1322  {$ELSE}
1323  //FPC: WideStrings are COM managed fields
1324  WS:=RowAccessor.GetUnicodeString(ColumnIndex, Result);
1325  //include null terminator in copy
1326  System.Move(PWideChar(WS)^,buffer^,(length(WS)+1)*sizeof(WideChar));
1327  {$ENDIF}
1328  Result := not Result;
1329  end;
1330  ftString{$IFDEF WITH_FTGUID}, ftGUID{$ENDIF}:
1331  begin
1332  {$IFDEF WITH_STRCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrCopy(PAnsiChar(Buffer), PAnsiChar({$IFDEF UNICODE}AnsiString{$ENDIF}(RowAccessor.GetString(ColumnIndex, Result))));
1333  Result := not Result;
1334  end;
1335  {$IFDEF WITH_FTDATASETSUPPORT}
1336  ftDataSet:
1337  Result := not RowAccessor.GetDataSet(ColumnIndex, Result).IsEmpty;
1338  {$ENDIF}
1339  { Processes all other fields. }
1340  ftCurrency:
1341  begin
1342  {SizeOf(double) = 8Byte but SizeOf(Extented) = 10 Byte, so i need to convert the value}
1343  ACurrency := RowAccessor.GetDouble(ColumnIndex, Result);
1344  System.Move(Pointer(@ACurrency)^, Pointer(Buffer)^, SizeOf(Double));
1345  Result := not Result;
1346  end;
1347  else
1348  begin
1349  System.Move(RowAccessor.GetColumnData(ColumnIndex, Result)^,
1350  Pointer(Buffer)^, RowAccessor.GetColumnDataSize(ColumnIndex));
1351  Result := not Result;
1352  end;
1353  end;
1354  end
1355  else
1356  begin
1357  if Field.DataType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo {$IFDEF WITH_WIDEMEMO},ftWideMemo{$ENDIF}] then
1358  Result := not RowAccessor.GetBlob(ColumnIndex, Result).IsEmpty
1359  else
1360  Result := not RowAccessor.IsNull(ColumnIndex);
1361  end;
1362  end
1363  else
1364  Result := False;
1365 end;
1366 
1367 {**
1368  Support for widestring field
1369 }
1370 procedure TZAbstractRODataset.SetFieldData(Field: TField; Buffer: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF};
1371  NativeFormat: Boolean);
1372 begin
1373  if Field.DataType in [ftWideString{$IFDEF WITH_WIDEMEMO}, ftWideMemo{$ENDIF}] then
1374  NativeFormat := True;
1375 
1376  {$IFNDEF VIRTUALSETFIELDDATA}
1377  inherited;
1378  {$ELSE}
1379  SetFieldData(Field, Buffer);
1380  {$ENDIF}
1381 end;
1382 
1383 {**
1384  Stores the column value from the field buffer.
1385  @param Field an field object to be stored.
1386  @param Buffer a field value buffer.
1387 }
1388 procedure TZAbstractRODataset.SetFieldData(Field: TField; Buffer: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF});
1389 var
1390  ColumnIndex: Integer;
1391  RowBuffer: PZRowBuffer;
1392  WasNull: Boolean;
1393  {$IFNDEF UNICODE}
1394  L: Cardinal;
1395  Temp: String;
1396  {$ENDIF}
1397 begin
1398  WasNull := False;
1399  if not Active then
1400  raise EZDatabaseError.Create(SOperationIsNotAllowed4);
1401  if not RequestLive and (Field.FieldKind = fkData) then
1402  RaiseReadOnlyError;
1403  // Check for readonly updates
1404  // Lookup values are requeried automatically on edit of all fields.
1405  // Didn't find a way to avoid this...
1406  if Field.ReadOnly and (Field.FieldKind <> fkLookup)
1407  and not (State in [dsSetKey, dsCalcFields, dsFilter, dsBlockRead, dsInternalCalc, dsOpening]) then
1408  DatabaseErrorFmt(SFieldReadOnly, [Field.DisplayName]);
1409  if not (State in dsWriteModes) then
1410  DatabaseError(SNotEditing, Self);
1411 
1412  if GetActiveBuffer(RowBuffer) then
1413  begin
1414  ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
1415  RowAccessor.RowBuffer := RowBuffer;
1416 
1417  if State in [dsEdit, dsInsert] then
1418  Field.Validate(Buffer);
1419 
1420  if Assigned(Buffer) then
1421  begin
1422  case Field.DataType of
1423  ftDate, ftDateTime: { Processes Date/DateTime fields. }
1424  RowAccessor.SetTimestamp(ColumnIndex, NativeToDateTime(Field.DataType, Buffer));
1425  ftTime: { Processes Time fields. }
1426  RowAccessor.SetTime(ColumnIndex, NativeToDateTime(Field.DataType, Buffer));
1427  ftBytes: { Processes binary array fields. }
1428  RowAccessor.SetBytes(ColumnIndex, BufferToBytes(Pointer(Buffer), Field.Size));
1429  ftWideString: { Processes widestring fields. }
1430  {$IFDEF WITH_PWIDECHAR_TOWIDESTRING}
1431  RowAccessor.SetUnicodeString(ColumnIndex, PWideChar(Buffer));
1432  {$ELSE}
1433  RowAccessor.SetUnicodeString(ColumnIndex, PWideString(Buffer)^);
1434  {$ENDIF}
1435  ftString{$IFDEF WITH_FTGUID}, ftGUID{$ENDIF}: { Processes string fields. }
1436  {$IFDEF UNICODE}
1437  RowAccessor.SetString(ColumnIndex, String(PAnsichar(Buffer)));
1438  {$ELSE}
1439  begin
1440  L := {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(PAnsiChar(Buffer));
1441  SetLength(Temp, L);
1442  Move(PAnsiChar(Buffer)^, PAnsiChar(Temp)^, L);
1443  RowAccessor.SetString(ColumnIndex, Temp);
1444  end;
1445  {$ENDIF}
1446  ftCurrency:
1447  {SizeOf(curreny) = 8Byte but SizeOf(Extented) = 10 Byte, so i need to convert the value}
1448  RowAccessor.SetDouble(ColumnIndex, PDouble(Buffer)^); //cast Currrency to Extented
1449  else { Processes all other fields. }
1450  begin
1451  System.Move(Pointer(Buffer)^, RowAccessor.GetColumnData(ColumnIndex, WasNull)^,
1452  RowAccessor.GetColumnDataSize(ColumnIndex));
1453  RowAccessor.SetNotNull(ColumnIndex);
1454  end;
1455  end;
1456  end
1457  else
1458  RowAccessor.SetNull(ColumnIndex);
1459 
1460  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
1461  DataEvent(deFieldChange, ULong(Field));
1462  end
1463  else
1464  raise EZDatabaseError.Create(SRowDataIsNotAvailable);
1465 
1466  if Field.FieldKind = fkData then
1467  begin
1468  OldRowBuffer.Index := -1;
1469  NewRowBuffer.Index := -1;
1470  end;
1471 end;
1472 
1473 {**
1474  Checks is the cursor opened.
1475  @return <code>True</code> if the cursor is opened.
1476 }
1477 function TZAbstractRODataset.IsCursorOpen: Boolean;
1478 begin
1479  Result := ResultSet <> nil;
1480 end;
1481 
1482 {**
1483  Gets an affected rows by the last executed statement.
1484  @return a number of last updated rows.
1485 }
1486 function TZAbstractRODataset.RowsAffected: LongInt;
1487 begin
1488  Result := FRowsAffected;
1489 end;
1490 
1491 {**
1492  Gets the size of the record buffer.
1493  @return the size of the record buffer.
1494 }
1495 function TZAbstractRODataset.GetRecordSize: Word;
1496 begin
1497  Result := RowAccessor.RowSize;
1498 end;
1499 
1500 {**
1501  Allocates a buffer for new record.
1502  @return an allocated record buffer.
1503 }
1504 
1505 {$IFDEF WITH_TRECORDBUFFER}
1506 
1507 function TZAbstractRODataset.AllocRecordBuffer: TRecordBuffer;
1508 begin
1509  Result := TRecordBuffer(RowAccessor.Alloc);
1510 end;
1511 {$ELSE}
1512 
1513 function TZAbstractRODataset.AllocRecordBuffer: PChar;
1514 begin
1515  Result := PChar(RowAccessor.Alloc);
1516 end;
1517 {$ENDIF}
1518 
1519 {**
1520  Frees a previously allocated record buffer.
1521  @param Buffer a previously allocated buffer.
1522 }
1523 
1524 {$IFDEF WITH_TRECORDBUFFER}
1525 
1526 procedure TZAbstractRODataset.FreeRecordBuffer(var Buffer: TRecordBuffer);
1527 {$ELSE}
1528 
1529 procedure TZAbstractRODataset.FreeRecordBuffer(var Buffer: PChar);
1530 {$ENDIF}
1531 begin
1532  RowAccessor.DisposeBuffer(PZRowBuffer(Buffer));
1533 end;
1534 
1535 {**
1536  Fetch all records. Added by Patyi
1537 }
1538 procedure TZAbstractRODataset.FetchAll;
1539 begin
1540  Connection.ShowSQLHourGlass;
1541  FetchRows(0);
1542  if Active then
1543  UpdateCursorPos;
1544  Connection.HideSQLHourGlass;
1545 end;
1546 
1547 {**
1548  Executes a DML SQL statement.
1549 }
1550 procedure TZAbstractRODataset.ExecSQL;
1551 begin
1552  if Active then
1553  begin
1554  Connection.ShowSQLHourGlass;
1555  try
1556  Close;
1557  finally
1558  Connection.HideSQLHourGlass;
1559  end;
1560  end;
1561 
1562  Prepare;
1563 
1564  Connection.ShowSQLHourGlass;
1565  try
1566  SetStatementParams(Statement, FSQL.Statements[0].ParamNamesArray,
1567  FParams, FDataLink);
1568 
1569  FRowsAffected := Statement.ExecuteUpdatePrepared;
1570  finally
1571  Connection.HideSQLHourGlass;
1572  end;
1573 end;
1574 
1575 {**
1576  Performs an internal initialization of field defiitions.
1577 }
1578 procedure TZAbstractRODataset.InternalInitFieldDefs;
1579 var
1580  I, J, Size: Integer;
1581  AutoInit: Boolean;
1582  FieldType: TFieldType;
1583  ResultSet: IZResultSet;
1584  FieldName: string;
1585  FName: string;
1586 begin
1587  FieldDefs.Clear;
1588  ResultSet := Self.ResultSet;
1589  AutoInit := ResultSet = nil;
1590 
1591  try
1592  { Opens an internal result set if query is closed. }
1593  if AutoInit then
1594  begin
1595  CheckSQLQuery;
1596  CheckConnected;
1597  Prepare;
1598  ResultSet := CreateResultSet(FSQL.Statements[0].SQL, 0);
1599  end;
1600  if not Assigned(ResultSet) then
1601  raise Exception.Create(SCanNotOpenResultSet);
1602 
1603  { Reads metadata from resultset. }
1604 
1605  with ResultSet.GetMetadata do
1606  begin
1607  if GetColumnCount > 0 then
1608  for I := 1 to GetColumnCount do
1609  begin
1610  FieldType := ConvertDbcToDatasetType(GetColumnType(I));
1611  //if IsCurrency(I) then
1612  //FieldType := ftCurrency;
1613  if FieldType in [ftBytes, ftString, ftWidestring] then
1614  Size := GetPrecision(I)
1615  else
1616  {$IFDEF WITH_FTGUID}
1617  if FieldType = ftGUID then
1618  Size := 38
1619  else
1620  {$ENDIF}
1621  Size := 0;
1622 
1623  J := 0;
1624  FieldName := GetColumnLabel(I);
1625  FName := FieldName;
1626  while FieldDefs.IndexOf(FName) >= 0 do
1627  begin
1628  Inc(J);
1629  FName := Format('%s_%d', [FieldName, J]);
1630  end;
1631 
1632  with TFieldDef.Create(FieldDefs, FName, FieldType,
1633  Size, False, I) do
1634  begin
1635  {$IFNDEF OLDFPC}
1636  Required := IsWritable(I) and (IsNullable(I) = ntNoNulls);
1637  {$ENDIF}
1638  if IsReadOnly(I) then Attributes := Attributes + [faReadonly];
1639  Precision := GetPrecision(I);
1640  DisplayName := FName;
1641  end;
1642  end;
1643  end;
1644 
1645  finally
1646  { Closes localy opened resultset. }
1647  if AutoInit then
1648  begin
1649  if ResultSet <> nil then
1650  begin
1651  ResultSet.Close;
1652  ResultSet := nil;
1653  end;
1654  UnPrepare;
1655  end;
1656  end;
1657 end;
1658 
1659 {**
1660  Creates a DBC statement for the query.
1661  @param SQL an SQL query.
1662  @param Properties a statement specific properties.
1663  @returns a created DBC statement.
1664 }
1665 function TZAbstractRODataset.CreateStatement(const SQL: string; Properties: TStrings):
1666  IZPreparedStatement;
1667 var
1668  Temp: TStrings;
1669 begin
1670  Temp := TStringList.Create;
1671  try
1672  if Assigned(Properties) then
1673  Temp.AddStrings(Properties);
1674  { Define TDataset specific parameters. }
1675  if doCalcDefaults in FOptions then
1676  Temp.Values['defaults'] := 'true'
1677  else
1678  Temp.Values['defaults'] := 'false';
1679  if doPreferPrepared in FOptions then
1680  Temp.Values['preferprepared'] := 'true'
1681  else
1682  Temp.Values['preferprepared'] := 'false';
1683 
1684  Result := FConnection.DbcConnection.PrepareStatementWithParams(SQL, Temp);
1685  finally
1686  Temp.Free;
1687  end;
1688 end;
1689 
1690 {**
1691  Creates a DBC resultset for the query.
1692  @param SQL an SQL query.
1693  @param MaxRows a maximum rows number (-1 for all).
1694  @returns a created DBC resultset.
1695 }
1696 function TZAbstractRODataset.CreateResultSet(const SQL: string;
1697  MaxRows: Integer): IZResultSet;
1698 begin
1699  Connection.ShowSQLHourGlass;
1700  try
1701  SetStatementParams(Statement, FSQL.Statements[0].ParamNamesArray,
1702  FParams, FDataLink);
1703  if RequestLive then
1704  Statement.SetResultSetConcurrency(rcUpdatable)
1705  else
1706  Statement.SetResultSetConcurrency(rcReadOnly);
1707  Statement.SetFetchDirection(fdForward);
1708  if IsUniDirectional then
1709  Statement.SetResultSetType(rtForwardOnly)
1710  else
1711  Statement.SetResultSetType(rtScrollInsensitive);
1712  if MaxRows > 0 then
1713  Statement.SetMaxRows(MaxRows);
1714 
1715  if doSmartOpen in FOptions then
1716  begin
1717  if Statement.ExecutePrepared then
1718  Result := Statement.GetResultSet
1719  else
1720  Result := nil;
1721  end
1722  else
1723  Result := Statement.ExecuteQueryPrepared;
1724  finally
1725  Connection.HideSQLHourGlass;
1726  end;
1727 end;
1728 
1729 {**
1730  Performs internal query opening.
1731 }
1732 procedure TZAbstractRODataset.InternalOpen;
1733 var
1734  ColumnList: TObjectList;
1735  I: Integer;
1736 begin
1737  {$IFNDEF FPC}
1738  If (csDestroying in Componentstate) then
1739  raise Exception.Create(SCanNotOpenDataSetWhenDestroying);
1740  {$ENDIF}
1741  if not FUseCurrentStatment then Prepare;
1742 
1743  CurrentRow := 0;
1744  FetchCount := 0;
1745  CurrentRows.Clear;
1746 
1747  Connection.ShowSQLHourGlass;
1748  try
1749  { Creates an SQL statement and resultsets }
1750  if not FUseCurrentStatment then
1751  if FSQL.StatementCount> 0 then
1752  ResultSet := CreateResultSet(FSQL.Statements[0].SQL, -1)
1753  else
1754  ResultSet := CreateResultSet('', -1);
1755  if not Assigned(ResultSet) then
1756  begin
1757  if not (doSmartOpen in FOptions) then
1758  raise Exception.Create(SCanNotOpenResultSet)
1759  else
1760  Exit;
1761  end;
1762 
1763  { Initializes field and index defs. }
1764  if not FRefreshInProgress then
1765  InternalInitFieldDefs;
1766 
1767  if DefaultFields and not FRefreshInProgress then
1768  begin
1769  CreateFields;
1770  for i := 0 to Fields.Count -1 do
1771  if Fields[i].DataType in [ftString, ftWideString{$IFDEF WITH_FTGUID}, ftGUID{$ENDIF}] then
1772  {$IFDEF WITH_FTGUID}
1773  if Fields[i].DataType = ftGUID then
1774  Fields[i].DisplayWidth := 40 //to get a full view of the GUID values
1775  else
1776  {$ENDIF}
1777  if not (ResultSet.GetMetadata.GetColumnDisplaySize(I+1) = 0) then
1778  begin
1779  {$IFNDEF FPC}Fields[i].Size := ResultSet.GetMetadata.GetColumnDisplaySize(I+1);{$ENDIF}
1780  Fields[i].DisplayWidth := ResultSet.GetMetadata.GetColumnDisplaySize(I+1);
1781  end;
1782  end;
1783  BindFields(True);
1784 
1785  { Initializes accessors and buffers. }
1786  ColumnList := ConvertFieldsToColumnInfo(Fields);
1787  try
1788  RowAccessor := TZRowAccessor.Create(ColumnList, Connection.DbcConnection.GetConSettings);
1789  finally
1790  ColumnList.Free;
1791  end;
1792  FOldRowBuffer := PZRowBuffer(AllocRecordBuffer);
1793  FNewRowBuffer := PZRowBuffer(AllocRecordBuffer);
1794 
1795  FieldsLookupTable := CreateFieldsLookupTable(Fields);
1796  InitFilterFields := False;
1797 
1798  IndexFields.Clear;
1799  GetFieldList(IndexFields, FLinkedFields); {renamed by bangfauzan}
1800 
1801  { Performs sorting. }
1802  if FSortedFields <> '' then
1803  InternalSort;
1804  finally
1805  Connection.HideSQLHourGlass;
1806  end;
1807 end;
1808 
1809 {**
1810  Performs internal query closing.
1811 }
1812 procedure TZAbstractRODataset.InternalClose;
1813 begin
1814  if ResultSet <> nil then
1815  if not FDoNotCloseResultSet then ResultSet.Close;
1816  ResultSet := nil;
1817 
1818  if FOldRowBuffer <> nil then
1819 {$IFDEF WITH_TRECORDBUFFER}
1820  FreeRecordBuffer(TRecordBuffer(FOldRowBuffer)); // TRecordBuffer can be both pbyte and pchar in FPC. Don't assume.
1821 {$ELSE}
1822  FreeRecordBuffer(PChar(FOldRowBuffer));
1823 {$ENDIF}
1824  FOldRowBuffer := nil;
1825  if FNewRowBuffer <> nil then
1826 {$IFDEF WITH_TRECORDBUFFER}
1827  FreeRecordBuffer(TRecordBuffer(FNewRowBuffer));
1828 {$ELSE}
1829  FreeRecordBuffer(PChar(FNewRowBuffer));
1830 {$ENDIF}
1831  FNewRowBuffer := nil;
1832 
1833  if RowAccessor <> nil then
1834  RowAccessor.Free;
1835  RowAccessor := nil;
1836 
1837  { Destroy default fields }
1838  if DefaultFields and not FRefreshInProgress then
1839  DestroyFields;
1840 
1841  CurrentRows.Clear;
1842  FieldsLookupTable := nil;
1843 end;
1844 
1845 {**
1846  Performs internal go to first record.
1847 }
1848 procedure TZAbstractRODataset.InternalFirst;
1849 begin
1850  if CurrentRow > 0 then
1851  CheckBiDirectional;
1852  CurrentRow := 0;
1853 end;
1854 
1855 {**
1856  Performs internal go to last record.
1857 }
1858 procedure TZAbstractRODataset.InternalLast;
1859 begin
1860  FetchRows(0);
1861  if CurrentRows.Count > 0 then
1862  CurrentRow := CurrentRows.Count + 1
1863  else
1864  CurrentRow := 0;
1865 end;
1866 
1867 {**
1868  Processes internal exception handling.
1869 }
1870 procedure TZAbstractRODataset.InternalHandleException;
1871 begin
1872 // Application.HandleException(Self);
1873 end;
1874 
1875 {**
1876  Gets the maximum records count.
1877  @return the maximum records count.
1878 }
1879 function TZAbstractRODataset.GetRecordCount: LongInt;
1880 begin
1881  CheckActive;
1882  if not IsUniDirectional then
1883  FetchRows(FFetchRow); // the orginal code was FetchRows(0); modifyed by Patyi
1884  Result := CurrentRows.Count;
1885 end;
1886 
1887 {**
1888  Gets the current record number.
1889  @return the current record number.
1890 }
1891 function TZAbstractRODataset.GetRecNo: Longint;
1892 begin
1893  if Active then
1894  UpdateCursorPos;
1895  Result := CurrentRow;
1896 end;
1897 
1898 {**
1899  Moves current record to the specified record.
1900  @param Value a new current record number.
1901 }
1902 procedure TZAbstractRODataset.MoveRecNo(Value: Integer);
1903 var
1904  PreviousCurrentRow: Integer;
1905 begin
1906  Value := Max(1, Value);
1907  if Value < CurrentRow then
1908  CheckBiDirectional;
1909 
1910  if FetchRows(Value) then
1911  CurrentRow := Value
1912  else
1913  CurrentRow := CurrentRows.Count;
1914 
1915  PreviousCurrentRow := CurrentRow;//Resync moves the current row away
1916  try
1917  if not (State in [dsInactive]) then
1918  Resync([]);
1919  finally
1920  CurrentRow := PreviousCurrentRow;
1921  end;
1922  UpdateCursorPos;
1923 end;
1924 
1925 {**
1926  Sets a new currenct record number.
1927  @param Value a new current record number.
1928 }
1929 procedure TZAbstractRODataset.SetRecNo(Value: Integer);
1930 begin
1931  CheckOpened;
1932  Value := Max(1, Value);
1933  if Value < CurrentRow then
1934  CheckBiDirectional;
1935 
1936  DoBeforeScroll;
1937  MoveRecNo(Value);
1938  DoAfterScroll;
1939 end;
1940 
1941 {**
1942  Defines is the query editable?
1943  @return <code>True</code> if the query is editable.
1944 }
1945 function TZAbstractRODataset.GetCanModify: Boolean;
1946 begin
1947  Result := RequestLive;
1948 end;
1949 
1950 {**
1951  Gets a linked datasource.
1952  @returns a linked datasource.
1953 }
1954 function TZAbstractRODataset.GetDataSource: TDataSource;
1955 begin
1956  Result := DataLink.DataSource;
1957 end;
1958 
1959 {**
1960  Sets the value of the Prepared property.
1961  Setting to <code>True</code> prepares the query. Setting to <code>False</code> unprepares.
1962  @param Value a new value for the Prepared property.
1963 }
1964 procedure TZAbstractRODataset.SetPrepared(Value: Boolean);
1965 begin
1966  FUseCurrentStatment := False;
1967  FDoNotCloseResultSet := False;
1968  If Value <> FPrepared then
1969  begin
1970  If Value then
1971  InternalPrepare
1972  else
1973  InternalUnprepare;
1974  FPrepared := Value;
1975  end;
1976 end;
1977 
1978 {**
1979  Sets a new linked datasource.
1980  @param Value a new linked datasource.
1981 }
1982 procedure TZAbstractRODataset.SetDataSource(Value: TDataSource);
1983 begin
1984  {$IFNDEF FPC}
1985  if IsLinkedTo(Value) then
1986  {$ELSE}
1987  if Value.IsLinkedTo(Self) then
1988  {$ENDIF}
1989  raise EZDatabaseError.Create(SCircularLink);
1990  DataLink.DataSource := Value;
1991 end;
1992 
1993 {**
1994  Gets a master datasource.
1995  @returns a master datasource.
1996 }
1997 function TZAbstractRODataset.GetMasterDataSource: TDataSource;
1998 begin
1999  Result := MasterLink.DataSource;
2000 end;
2001 
2002 {**
2003  Sets a new master datasource.
2004  @param Value a new master datasource.
2005 }
2006 procedure TZAbstractRODataset.SetMasterDataSource(Value: TDataSource);
2007 begin
2008  {$IFNDEF FPC}
2009  if IsLinkedTo(Value) then
2010  {$ELSE}
2011  if Value.IsLinkedTo(Self) then
2012  {$ENDIF}
2013  raise EZDatabaseError.Create(SCircularLink);
2014  MasterLink.DataSource := Value;
2015  RereadRows;
2016 end;
2017 
2018 {**
2019  Gets master link fields.
2020  @returns a list with master fields.
2021 }
2022 function TZAbstractRODataset.GetMasterFields: string;
2023 begin
2024  Result := FMasterLink.FieldNames;
2025 end;
2026 
2027 {**
2028  Sets master link fields.
2029  @param Value a new master link fields.
2030 }
2031 procedure TZAbstractRODataset.SetMasterFields(const Value: string);
2032 begin
2033  if FMasterLink.FieldNames <> Value then
2034  begin
2035  FMasterLink.FieldNames := Value;
2036  RereadRows;
2037  end;
2038 end;
2039 
2040 {**
2041  Processes change events from the master dataset.
2042  @param Sender an event sender object.
2043 }
2044 procedure TZAbstractRODataset.MasterChanged(Sender: TObject);
2045 begin
2046  CheckBrowseMode;
2047  if (doAlwaysDetailResync in FOptions) or (FMasterLink.DataSet = nil)
2048  or not (FMasterLink.DataSet.State in [dsEdit, dsInsert]) then
2049  RereadRows;
2050 end;
2051 
2052 {**
2053  Processes disable events from the master dataset.
2054  @param Sender an event sender object.
2055 }
2056 procedure TZAbstractRODataset.MasterDisabled(Sender: TObject);
2057 begin
2058  RereadRows;
2059 end;
2060 
2061 {**
2062  Initializes new record with master fields.
2063 }
2064 {$WARNINGS OFF}
2065 procedure TZAbstractRODataset.DoOnNewRecord;
2066 var
2067  I: Integer;
2068  MasterField, DetailField: TField;
2069  Temp: Int64;
2070  P1, P2 : Integer;
2071 begin
2072  if MasterLink.Active and (MasterLink.Fields.Count > 0) then
2073  begin
2074  for I := 0 to MasterLink.Fields.Count - 1 do
2075  begin
2076  if I < IndexFields.Count then
2077  begin
2078  MasterField := TField(MasterLink.Fields[I]);
2079  DetailField := TField(IndexFields[I]);
2080  // Processes LargeInt fields.
2081  if (MasterField is TLargeIntField)
2082  or (DetailField is TLargeIntField) then
2083  begin
2084  if MasterField is TLargeIntField then
2085  Temp := TLargeIntField(
2086  MasterField).{$IFDEF WITH_ASLARGEINT}AsLargeInt{$ELSE}Value{$ENDIF}
2087  else
2088  Temp := MasterField.AsInteger;
2089  if DetailField is TLargeIntField then
2090  TLargeIntField(DetailField).{$IFDEF WITH_ASLARGEINT}AsLargeInt{$ELSE}Value{$ENDIF} := Temp
2091  else
2092  DetailField.AsString := IntToStr(Temp);
2093  end
2094  // Processes all other fields.
2095  else
2096  DetailField.Value := MasterField.Value;
2097  end;
2098  end;
2099  end
2100  else
2101  begin
2102  if DataLink.Active and (DataLink.dataset.Fields.Count > 0) then
2103  begin
2104  p1 := 1; p2 := 1;
2105  while (P1 <= Length(LinkedFields)) and (p2 <= Length(MasterFields)) do
2106  begin
2107  DetailField := FieldByName(ExtractFieldName(LinkedFields, P1));
2108  MasterField := DataLink.DataSet.FieldByName (ExtractFieldName(MasterFields, P2));
2109  DetailField.Assign(MasterField);
2110  end;
2111  end;
2112  end;
2113  inherited DoOnNewRecord;
2114 end;
2115 {$WARNINGS ON}
2116 
2117 {**
2118  Gets a list of index field names.
2119  @returns a list of index field names.
2120 }
2121 function TZAbstractRODataset.GetLinkedFields: string; {renamed by bangfauzan}
2122 begin
2123  Result := FLinkedFields; {renamed by bangfauzan}
2124 end;
2125 
2126 {**
2127  Sets a new list of index field names.
2128  @param Value a new list of index field names.
2129 }
2130 procedure TZAbstractRODataset.SetLinkedFields(const Value: string); {renamed by bangfauzan}
2131 begin
2132  if FLinkedFields <> Value then {renamed by bangfauzan}
2133  begin
2134  FLinkedFields := Value; {renamed by bangfauzan}
2135  IndexFields.Clear;
2136  if State <> dsInactive then
2137  begin
2138  GetFieldList(IndexFields, FLinkedFields); {renamed by bangfauzan}
2139  RereadRows;
2140  end;
2141  end;
2142 end;
2143 
2144 {**
2145  Sets a new set of dataset options.
2146  @param Value a new set of dataset options.
2147 }
2148 procedure TZAbstractRODataset.SetOptions(Value: TZDatasetOptions);
2149 begin
2150  if FOptions <> Value then
2151  FOptions := Value;
2152 end;
2153 
2154 {**
2155  Sets a new sorted fields.
2156  @param Value a new sorted fields.
2157 }
2158 procedure TZAbstractRODataset.SetSortedFields({const} Value: string); {bangfauzan modification}
2159 begin
2160  Value:=Trim(Value); {bangfauzan addition}
2161  if (FSortedFields <> Value) or (FIndexFieldNames <> Value)then {bangfauzan modification}
2162  begin
2163  FIndexFieldNames:=Value;
2164  FSortType := GetSortType; {bangfauzan addition}
2165  {removing ASC or DESC behind space}
2166  if (FSortType <> stIgnored) then
2167  begin {pawelsel modification}
2168  Value:=StringReplace(Value,' Desc','',[rfReplaceAll,rfIgnoreCase]);
2169  Value:=StringReplace(Value,' Asc','',[rfReplaceAll,rfIgnoreCase]);
2170  end;
2171  FSortedFields := Value;
2172  if Active then
2173  {InternalSort;}
2174  {bangfauzan modification}
2175  if (FSortedFields = '') then
2176  Self.InternalRefresh
2177  else
2178  InternalSort;
2179  {end of bangfauzan modification}
2180  end;
2181 end;
2182 
2183 {**
2184  Refreshes parameters and reopens the dataset.
2185 }
2186 procedure TZAbstractRODataset.RefreshParams;
2187 var
2188  DataSet: TDataSet;
2189 begin
2190  DisableControls;
2191  try
2192  if FDataLink.DataSource <> nil then
2193  begin
2194  DataSet := FDataLink.DataSource.DataSet;
2195  if DataSet <> nil then
2196  if DataSet.Active and not (DataSet.State in [dsSetKey, dsEdit]) then
2197  begin
2198  Refresh;
2199  end;
2200  end;
2201  finally
2202  EnableControls;
2203  end;
2204 end;
2205 
2206 {**
2207  Performs the internal preparation of the query.
2208 }
2209 procedure TZAbstractRODataset.InternalPrepare;
2210 begin
2211  CheckSQLQuery;
2212  CheckInactive; //AVZ - Need to check this
2213  CheckConnected;
2214 
2215  Connection.ShowSQLHourGlass;
2216  try
2217  if (FSQL.StatementCount > 0) and((Statement = nil) or (Statement.GetConnection.IsClosed)) then
2218  Statement := CreateStatement(FSQL.Statements[0].SQL, Properties)
2219  else
2220  if (Assigned(Statement)) then
2221  Statement.ClearParameters;
2222  finally
2223  Connection.HideSQLHourGlass;
2224  end;
2225 end;
2226 
2227 {**
2228  Rolls back the internal preparation of the query.
2229 }
2230 procedure TZAbstractRODataset.InternalUnPrepare;
2231 begin
2232  if Statement <> nil then
2233  begin
2234  Statement.Close;
2235  Statement := nil;
2236  end;
2237 end;
2238 
2239 {**
2240  Performs internal switch to the specified bookmark.
2241  @param Bookmark a specified bookmark.
2242 }
2243 procedure TZAbstractRODataset.InternalGotoBookmark(Bookmark: Pointer);
2244 begin
2245  if not GotoRow(PInteger(Bookmark)^) then
2246  raise EZDatabaseError.Create(SBookmarkWasNotFound);
2247 end;
2248 
2249 {**
2250  Performs an internal switch to the specified record.
2251  @param Buffer the specified row buffer.
2252 }
2253 
2254 {$IFDEF WITH_TRECORDBUFFER}
2255 procedure TZAbstractRODataset.InternalSetToRecord(Buffer: TRecordBuffer);
2256 {$ELSE}
2257 procedure TZAbstractRODataset.InternalSetToRecord(Buffer: PChar);
2258 {$ENDIF}
2259 begin
2260  GotoRow(PZRowBuffer(Buffer)^.Index);
2261 end;
2262 
2263 {**
2264  Performs an internal adding a new record.
2265  @param Buffer a buffer of the new adding record.
2266  @param Append <code>True</code> if record should be added to the end
2267  of the result set.
2268 }
2269 procedure TZAbstractRODataset.InternalAddRecord(Buffer: Pointer;
2270  Append: Boolean);
2271 begin
2272  RaiseReadOnlyError;
2273 end;
2274 
2275 {**
2276  Performs an internal record removing.
2277 }
2278 procedure TZAbstractRODataset.InternalDelete;
2279 begin
2280  RaiseReadOnlyError;
2281 end;
2282 
2283 {**
2284  Performs an internal post updates.
2285 }
2286 procedure TZAbstractRODataset.InternalPost;
2287  procedure Checkrequired;
2288  var
2289  I: longint;
2290  columnindex : integer;
2291  begin
2292  For I:=0 to Fields.Count-1 do
2293  With Fields[i] do
2294  Case State of
2295  dsEdit:
2296  if Required and not ReadOnly and (FieldKind=fkData) and IsNull then
2297  raise EZDatabaseError.Create(Format(SNeedField,[DisplayName]));
2298  dsInsert:
2299  if Required and not ReadOnly and (FieldKind=fkData) and IsNull then
2300  begin
2301  // allow autoincrement and defaulted fields to be null;
2302  columnindex := Resultset.FindColumn(Fields[i].FieldName);
2303  if (Columnindex = 0) or
2304  (not Resultset.GetMetadata.HasDefaultValue(columnIndex) and
2305  not Resultset.GetMetadata.IsAutoIncrement(columnIndex)) then
2306  raise EZDatabaseError.Create(Format(SNeedField,[DisplayName]));
2307  end;
2308  End;
2309  end;
2310 
2311 begin
2312  if not (Self is TZAbstractDataset) then
2313  RaiseReadOnlyError;
2314 
2315  Checkrequired;
2316 end;
2317 
2318 {**
2319  Gets a bookmark flag from the specified record.
2320  @param Buffer a pointer to the record buffer.
2321  @return a bookmark flag from the specified record.
2322 }
2323 
2324 {$IFDEF WITH_TRECORDBUFFER}
2325 
2326 function TZAbstractRODataset.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
2327 {$ELSE}
2328 
2329 function TZAbstractRODataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
2330 {$ENDIF}
2331 begin
2332  Result := TBookmarkFlag(PZRowBuffer(Buffer)^.BookmarkFlag);
2333 end;
2334 
2335 {**
2336  Sets a new bookmark flag to the specified record.
2337  @param Buffer a pointer to the record buffer.
2338  @param Value a new bookmark flag to the specified record.
2339 }
2340 
2341 {$IFDEF WITH_TRECORDBUFFER}
2342 procedure TZAbstractRODataset.SetBookmarkFlag(Buffer: TRecordBuffer;
2343  Value: TBookmarkFlag);
2344 {$ELSE}
2345 procedure TZAbstractRODataset.SetBookmarkFlag(Buffer: PChar;
2346  Value: TBookmarkFlag);
2347 {$ENDIF}
2348 begin
2349  PZRowBuffer(Buffer)^.BookmarkFlag := Ord(Value);
2350 end;
2351 
2352 {**
2353  Gets bookmark value from the specified record.
2354  @param Buffer a pointer to the record buffer.
2355  @param Data a pointer to the bookmark value.
2356 }
2357 
2358 procedure TZAbstractRODataset.GetBookmarkData(
2359  Buffer: {$IFDEF WITH_TRECORDBUFFER}TRecordBuffer{$ELSE}PChar{$ENDIF};
2360  Data: {$IFDEF WITH_BOOKMARKDATA_TBOOKMARK}TBookMark{$ELSE}Pointer{$ENDIF});
2361 begin
2362  PInteger(Data)^ := PZRowBuffer(Buffer)^.Index;
2363 end;
2364 
2365 {**
2366  Sets a new bookmark value from the specified record.
2367  @param Buffer a pointer to the record buffer.
2368  @param Data a pointer to the bookmark value.
2369 }
2370 
2371 
2372 procedure TZAbstractRODataset.SetBookmarkData(
2373  Buffer: {$IFDEF WITH_TRECORDBUFFER}TRecordBuffer{$ELSE}PChar{$ENDIF};
2374  Data: {$IFDEF WITH_BOOKMARKDATA_TBOOKMARK}TBookMark{$ELSE}Pointer{$ENDIF});
2375 begin
2376  PZRowBuffer(Buffer)^.Index := PInteger(Data)^;
2377 end;
2378 
2379 {**
2380  Compare two specified bookmarks.
2381  @param Bookmark1 the first bookmark object.
2382  @param Bookmark2 the second bookmark object.
2383  @return 0 if bookmarks are equal, -1 if the first bookmark is less,
2384  1 if the first bookmark is greatter.
2385 }
2386 function TZAbstractRODataset.CompareBookmarks(Bookmark1,
2387  Bookmark2: TBookmark): Integer;
2388 var
2389  Index1, Index2: Integer;
2390 begin
2391  Result := 0;
2392  if not Assigned(Bookmark1) or not Assigned(Bookmark2) then
2393  Exit;
2394 
2395  Index1 := CurrentRows.IndexOf(Pointer(PInteger(Bookmark1)^));
2396  Index2 := CurrentRows.IndexOf(Pointer(PInteger(Bookmark2)^));
2397 
2398  if Index1 < Index2 then Result := -1
2399  else if Index1 > Index2 then Result := 1;
2400 end;
2401 
2402 {**
2403  Checks is the specified bookmark valid.
2404  @param Bookmark a bookmark object.
2405  @return <code>True</code> if the bookmark is valid.
2406 }
2407 function TZAbstractRODataset.BookmarkValid(Bookmark: TBookmark): Boolean;
2408 begin
2409  Result := False;
2410  if Active and Assigned(Bookmark) and (FResultSet <> nil) then
2411  try
2412  Result := CurrentRows.IndexOf(Pointer(PInteger(Bookmark)^)) >= 0;
2413  except
2414  Result := False;
2415  end;
2416 end;
2417 
2418 {**
2419  Performs an internal initialization of record buffer.
2420  @param Buffer a record buffer for initialization.
2421 }
2422 
2423 {$IFDEF WITH_TRECORDBUFFER}
2424 procedure TZAbstractRODataset.InternalInitRecord(Buffer: TRecordBuffer);
2425 {$ELSE}
2426 procedure TZAbstractRODataset.InternalInitRecord(Buffer: PChar);
2427 {$ENDIF}
2428 begin
2429  RowAccessor.ClearBuffer(PZRowBuffer(Buffer));
2430 end;
2431 
2432 {**
2433  Performs an internal refreshing.
2434 }
2435 procedure TZAbstractRODataset.InternalRefresh;
2436 var
2437  RowNo: Integer;
2438  Found: Boolean;
2439  KeyFields: string;
2440  Temp: TZVariantDynArray;
2441  KeyValues: Variant;
2442  FieldRefs: TObjectDynArray;
2443  OnlyDataFields: Boolean;
2444 begin
2445  OnlyDataFields := False;
2446  FieldRefs := nil;
2447  if Active then
2448  begin
2449  if CurrentRow > 0 then
2450  begin
2451  RowNo := Integer(CurrentRows[CurrentRow - 1]);
2452  if ResultSet.GetRow <> RowNo then
2453  ResultSet.MoveAbsolute(RowNo);
2454 
2455  if Properties.Values['KeyFields'] <> '' then
2456  KeyFields := Properties.Values['KeyFields']
2457  else
2458  KeyFields := DefineKeyFields(Fields);
2459  FieldRefs := DefineFields(Self, KeyFields, OnlyDataFields);
2460  SetLength(Temp, Length(FieldRefs));
2461  RetrieveDataFieldsFromResultSet(FieldRefs, ResultSet, Temp);
2462  if Length(FieldRefs) = 1 then
2463  KeyValues := EncodeVariant(Temp[0])
2464  else
2465  KeyValues := EncodeVariantArray(Temp);
2466  end
2467  else
2468  begin
2469  KeyFields := '';
2470  KeyValues := Unassigned;
2471  end;
2472 
2473  DisableControls;
2474  try
2475  try
2476  FRefreshInProgress := True;
2477  InternalClose;
2478  InternalOpen;
2479  finally
2480  FRefreshInProgress := False;
2481  end;
2482 
2483  DoBeforeScroll;
2484  if KeyFields <> '' then
2485  Found := Locate(KeyFields, KeyValues, [])
2486  else
2487  Found := False;
2488  finally
2489  EnableControls;
2490  end;
2491 
2492  if not Found then
2493  begin
2494  DoBeforeScroll;
2495  DoAfterScroll;
2496  end;
2497  end;
2498 end;
2499 
2500 {**
2501  Finds the next record in a filtered query.
2502  @param Restart a <code>True</code> to find from the start of the query.
2503  @param GoForward <code>True</code> to navigate in the forward direction.
2504  @return <code>True</code> if a sutisfied row was found.
2505 }
2506 function TZAbstractRODataset.FindRecord(Restart, GoForward: Boolean): Boolean;
2507 var
2508  Index: Integer;
2509  SavedFilterEnabled: Boolean;
2510 begin
2511  { Checks the current state. }
2512  CheckBrowseMode;
2513  DoBeforeScroll;
2514  Result := False;
2515 
2516  { Defines an initial position position. }
2517  if Restart then
2518  begin
2519  if GoForward then
2520  Index := 1
2521  else
2522  begin
2523  FetchRows(0);
2524  Index := CurrentRows.Count;
2525  end
2526  end
2527  else
2528  begin
2529  Index := CurrentRow;
2530  if GoForward then
2531  begin
2532  Inc(Index);
2533  if Index > CurrentRows.Count then
2534  FetchOneRow;
2535  end
2536  else
2537  Dec(Index);
2538  end;
2539 
2540  { Finds a record. }
2541  SavedFilterEnabled := FilterEnabled;
2542  try
2543  FilterEnabled := True;
2544  while (Index >= 1) and (Index <= CurrentRows.Count) do
2545  begin
2546  if FilterRow(Index) then
2547  begin
2548  Result := True;
2549  Break;
2550  end;
2551  if GoForward then
2552  begin
2553  Inc(Index);
2554  if Index > CurrentRows.Count then
2555  FetchOneRow;
2556  end
2557  else
2558  Dec(Index)
2559  end
2560  finally
2561  FilterEnabled := SavedFilterEnabled;
2562  end;
2563 
2564  { Sets a new found position. }
2565  SetFound(Result);
2566  if Result then
2567  begin
2568  MoveRecNo(Index);
2569  DoAfterScroll;
2570  end;
2571 end;
2572 
2573 {**
2574  Sets a filtering control flag.
2575  @param Value <code>True</code> to turn filtering On.
2576 }
2577 procedure TZAbstractRODataset.SetFiltered(Value: Boolean);
2578 begin
2579  if Value <> FilterEnabled then
2580  begin
2581  FilterEnabled := Value;
2582  inherited SetFiltered(Value);
2583  RereadRows;
2584  end;
2585 end;
2586 
2587 {**
2588  Sets a new filter expression string.
2589  @param Value a new filter expression.
2590 }
2591 procedure TZAbstractRODataset.SetFilterText(const Value: string);
2592 begin
2593  inherited SetFilterText(Value);
2594  FilterExpression.DefaultVariables.Clear;
2595  FilterExpression.Expression := Value;
2596  InitFilterFields := False;
2597  if FilterEnabled then
2598  RereadRows;
2599 end;
2600 
2601 {**
2602  Checks is the opened resultset sequensed?
2603  @return <code>True</code> if the opened resultset is sequenced.
2604 }
2605 function TZAbstractRODataset.IsSequenced: Boolean;
2606 begin
2607  Result := (not FilterEnabled);
2608 end;
2609 
2610 {**
2611  Processes component notifications.
2612  @param AComponent a changed component object.
2613  @param Operation a component operation code.
2614 }
2615 procedure TZAbstractRODataset.Notification(AComponent: TComponent;
2616  Operation: TOperation);
2617 begin
2618  inherited Notification(AComponent, Operation);
2619 
2620  if (Operation = opRemove) and (AComponent = FConnection) then
2621  begin
2622  Close;
2623  FConnection := nil;
2624  end;
2625 
2626  if (Operation = opRemove) and Assigned(FDataLink)
2627  and (AComponent = FDataLink.Datasource) then
2628  FDataLink.DataSource := nil;
2629 
2630  if (Operation = opRemove) and Assigned(FMasterLink)
2631  and (AComponent = FMasterLink.Datasource) then
2632  begin
2633  FMasterLink.DataSource := nil;
2634  RereadRows;
2635  end;
2636 end;
2637 
2638 {**
2639  Performs an internal record search.
2640  @param KeyFields a list of field names.
2641  @param KeyValues a list of field values.
2642  @param Options a search options.
2643  @return an index of found row or -1 if nothing was found.
2644 }
2645 function TZAbstractRODataset.InternalLocate(const KeyFields: string;
2646  const KeyValues: Variant; Options: TLocateOptions): LongInt;
2647 var
2648  I, RowNo, RowCount: Integer;
2649  FieldRefs: TObjectDynArray;
2650  FieldIndices: TIntegerDynArray;
2651  OnlyDataFields: Boolean;
2652  SearchRowBuffer: PZRowBuffer;
2653  DecodedKeyValues: TZVariantDynArray;
2654  RowValues: TZVariantDynArray;
2655  PartialKey: Boolean;
2656  CaseInsensitive: Boolean;
2657 begin
2658  OnlyDataFields := False;
2659  CheckBrowseMode;
2660  Result := -1;
2661  DecodedKeyValues := nil;
2662 
2663  PartialKey := loPartialKey in Options;
2664  CaseInsensitive := loCaseInsensitive in Options;
2665 
2666  FieldRefs := DefineFields(Self, KeyFields, OnlyDataFields);
2667  FieldIndices := nil;
2668  if FieldRefs = nil then
2669  Exit;
2670  DecodedKeyValues := DecodeVariantArray(KeyValues);
2671 
2672  { Checks for equal field and values number }
2673  if Length(FieldRefs) <> Length(DecodedKeyValues) then
2674  raise EZDatabaseError.Create(SIncorrectSearchFieldsNumber);
2675  SetLength(RowValues, Length(DecodedKeyValues));
2676 
2677  if not OnlyDataFields then
2678  begin
2679  { Processes fields if come calculated or lookup fields are involved. }
2680  SearchRowBuffer := PZRowBuffer(AllocRecordBuffer);
2681  try
2682  I := 0;
2683  FieldIndices := DefineFieldIndices(FieldsLookupTable, FieldRefs);
2684  RowCount := CurrentRows.Count;
2685  while True do
2686  begin
2687  while (I >= RowCount) and FetchOneRow do
2688  RowCount := CurrentRows.Count;
2689  if I >= RowCount then
2690  Break;
2691 
2692  RowNo := Integer(CurrentRows[I]);
2693  ResultSet.MoveAbsolute(RowNo);
2694 
2695  RowAccessor.RowBuffer := SearchRowBuffer;
2696  RowAccessor.RowBuffer^.Index := RowNo;
2697  FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
2698 {$IFDEF WITH_TRECORDBUFFER}
2699  GetCalcFields({$IFDEF WITH_GETCALCFIELDS_TRECBUF}NativeInt{$ELSE}TRecordBuffer{$ENDIF}(SearchRowBuffer));
2700 {$ELSE}
2701  GetCalcFields(PChar(SearchRowBuffer));
2702 {$ENDIF}
2703  RetrieveDataFieldsFromRowAccessor(
2704  FieldRefs, FieldIndices, RowAccessor, RowValues);
2705 
2706  if CompareDataFields(DecodedKeyValues, RowValues,
2707  PartialKey, CaseInsensitive) then
2708  begin
2709  Result := I + 1;
2710  Break;
2711  end;
2712 
2713  Inc(I);
2714  end;
2715  finally
2716  if SearchRowBuffer <> nil then
2717 {$IFDEF WITH_TRECORDBUFFER}
2718  FreeRecordBuffer(TRecordBuffer(SearchRowBuffer));
2719 {$ELSE}
2720  FreeRecordBuffer(PChar(SearchRowBuffer));
2721 {$ENDIF}
2722  end;
2723  end
2724  else
2725  begin
2726  PrepareValuesForComparison(FieldRefs, DecodedKeyValues,
2727  ResultSet, PartialKey, CaseInsensitive);
2728 
2729  { Processes only data fields. }
2730  I := 0;
2731  RowCount := CurrentRows.Count;
2732  while True do
2733  begin
2734  while (I >= RowCount) and FetchOneRow do
2735  RowCount := CurrentRows.Count;
2736  if I >= RowCount then
2737  Break;
2738 
2739  RowNo := Integer(CurrentRows[I]);
2740  ResultSet.MoveAbsolute(RowNo);
2741 
2742  if CompareFieldsFromResultSet(FieldRefs, DecodedKeyValues,
2743  ResultSet, PartialKey, CaseInsensitive) then
2744  begin
2745  Result := I + 1;
2746  Break;
2747  end;
2748 
2749  Inc(I);
2750  end;
2751  end;
2752 end;
2753 
2754 {**
2755  Locates an interested record by specified search criteria.
2756  @param KeyFields a list of field names.
2757  @param KeyValues a list of field values.
2758  @param Options a search options.
2759  @return <code>True</code> if record was found or <code>False</code> otherwise.
2760 }
2761 function TZAbstractRODataset.Locate(const KeyFields: string;
2762  const KeyValues: Variant; Options: TLocateOptions): Boolean;
2763 var
2764  Index: Integer;
2765 begin
2766  DoBeforeScroll;
2767  if (Active) then //AVZ Check if the dataset is active before performing locate - return false otherwise
2768  begin
2769  Index := InternalLocate(KeyFields, KeyValues, Options);
2770  if Index > 0 then
2771  begin
2772  MoveRecNo(Index);
2773  DoAfterScroll;
2774  Result := True;
2775  end
2776  else
2777  Result := False;
2778  SetFound(Result);
2779 
2780  end
2781  else
2782  begin
2783  Result := False;
2784  end;
2785 end;
2786 
2787 {**
2788  Lookups specified fields from the searched record.
2789  @param KeyValues a list of field names to search record.
2790  @param KeyValues an array of field values to search record.
2791  @param ResultFields a list of field names to return as a result.
2792  @return an array of requested field values.
2793 }
2794 function TZAbstractRODataset.Lookup(const KeyFields: string;
2795  const KeyValues: Variant; const ResultFields: string): Variant;
2796 var
2797  RowNo: Integer;
2798  FieldRefs: TObjectDynArray;
2799  FieldIndices: TIntegerDynArray;
2800  OnlyDataFields: Boolean;
2801  SearchRowBuffer: PZRowBuffer;
2802  ResultValues: TZVariantDynArray;
2803 begin
2804  OnlyDataFields := False;
2805  Result := Null;
2806  RowNo := InternalLocate(KeyFields, KeyValues, []);
2807  FieldRefs := nil;
2808  FieldIndices := nil;
2809  if RowNo < 0 then
2810  Exit;
2811 
2812  { Fill result array }
2813  FieldRefs := DefineFields(Self, ResultFields, OnlyDataFields);
2814  FieldIndices := DefineFieldIndices(FieldsLookupTable, FieldRefs);
2815  SetLength(ResultValues, Length(FieldRefs));
2816  SearchRowBuffer := PZRowBuffer(AllocRecordBuffer);
2817  try
2818  RowNo := Integer(CurrentRows[RowNo - 1]);
2819  if ResultSet.GetRow <> RowNo then
2820  ResultSet.MoveAbsolute(RowNo);
2821 
2822  RowAccessor.RowBuffer := SearchRowBuffer;
2823  RowAccessor.RowBuffer^.Index := RowNo;
2824  FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
2825 {$IFDEF WITH_TRECORDBUFFER}
2826  GetCalcFields({$IFDEF WITH_GETCALCFIELDS_TRECBUF}NativeInt{$ELSE}TRecordBuffer{$ENDIF}(SearchRowBuffer));
2827 {$ELSE}
2828  GetCalcFields(PChar(SearchRowBuffer));
2829 {$ENDIF}
2830  RetrieveDataFieldsFromRowAccessor(
2831  FieldRefs, FieldIndices, RowAccessor, ResultValues);
2832  finally
2833 {$IFDEF WITH_TRECORDBUFFER}
2834  FreeRecordBuffer(TRecordBuffer(SearchRowBuffer));
2835 {$ELSE}
2836  FreeRecordBuffer(PChar(SearchRowBuffer));
2837 {$ENDIF}
2838  end;
2839 
2840  if Length(FieldIndices) = 1 then
2841  Result := EncodeVariant(ResultValues[0])
2842  else
2843  Result := EncodeVariantArray(ResultValues);
2844 end;
2845 
2846 {**
2847  Gets the updated status for the current row.
2848  @return the UpdateStatus value for the current row.
2849 }
2850 function TZAbstractRODataset.UpdateStatus: TUpdateStatus;
2851 var
2852  RowNo: Integer;
2853 begin
2854  Result := usUnmodified;
2855  if (ResultSet <> nil) and (CurrentRows.Count > 0) then
2856  begin
2857  RowNo := Integer(CurrentRows[CurrentRow - 1]);
2858  if ResultSet.GetRow <> RowNo then
2859  ResultSet.MoveAbsolute(RowNo);
2860 
2861  if ResultSet.RowInserted then
2862  Result := usInserted
2863  else if ResultSet.RowUpdated then
2864  Result := usModified
2865  else if ResultSet.RowDeleted then
2866  Result := usDeleted;
2867  end;
2868 end;
2869 
2870 {**
2871  Translates strings between ansi and oem character sets.
2872 }
2873 function TZAbstractRODataset.Translate(Src, Dest: PAnsiChar; ToOem: Boolean):
2874  Integer;
2875 begin
2876  if (Src <> nil) then
2877  begin
2878  Result := {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(Src);
2879  {$IFNDEF UNIX}
2880  if doOemTranslate in FOptions then
2881  begin
2882  if ToOem then
2883  CharToOemA(Src, Dest)
2884  else
2885  OemToCharA(Src, Dest);
2886  Dest[Result] := #0;
2887  end
2888  else
2889  {$ENDIF}
2890  begin
2891  if (Src <> Dest) then
2892  {$IFDEF WITH_STRCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrCopy(Dest, Src);
2893  end;
2894  end
2895  else
2896  Result := 0;
2897 end;
2898 
2899 {**
2900  Prepares the query.
2901  If this actually does happen at the database connection level depends on the
2902  specific implementation.
2903 }
2904 procedure TZAbstractRODataset.Prepare;
2905 begin
2906  Prepared := True;
2907 end;
2908 
2909 {**
2910  Unprepares the query.
2911  Before the query gets executed it must be prepared again.
2912 }
2913 procedure TZAbstractRODataset.Unprepare;
2914 begin
2915  Prepared := False;
2916 end;
2917 
2918 {**
2919  Creates a stream object for specified blob field.
2920  @param Field an interested field object.
2921  @param Mode a blob open mode.
2922  @return a created stream object.
2923 }
2924 function TZAbstractRODataset.CreateBlobStream(Field: TField;
2925  Mode: TBlobStreamMode): TStream;
2926 var
2927  ColumnIndex: Integer;
2928  RowBuffer: PZRowBuffer;
2929  Blob: IZBlob;
2930  WasNull: Boolean;
2931 begin
2932  WasNull := False;
2933  CheckActive;
2934 
2935  Result := nil;
2936  if (Field.DataType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo {$IFDEF WITH_WIDEMEMO},ftWideMemo{$ENDIF}])
2937  and GetActiveBuffer(RowBuffer) then
2938  begin
2939  ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
2940  RowAccessor.RowBuffer := RowBuffer;
2941 
2942  if Mode = bmRead then
2943  begin
2944  case Field.DataType of
2945  ftMemo, ftFmtMemo:
2946  Result := RowAccessor.GetAsciiStream(ColumnIndex, WasNull);
2947  {$IFDEF WITH_WIDEMEMO}
2948  ftWideMemo:
2949  Result := RowAccessor.GetUnicodeStream(ColumnIndex, WasNull)
2950  {$ENDIF}
2951  else
2952  Result := RowAccessor.GetBinaryStream(ColumnIndex, WasNull);
2953  end;
2954  end
2955  else
2956  begin
2957  Blob := RowAccessor.GetBlob(ColumnIndex, WasNull);
2958  if Blob <> nil then
2959  Blob := Blob.Clone;
2960  RowAccessor.SetBlob(ColumnIndex, Blob);
2961  Result := TZBlobStream.Create(Field as TBlobField, Blob, Mode,
2962  FConnection.DbcConnection.GetConSettings);
2963  end;
2964  end;
2965  if Result = nil then
2966  Result := TMemoryStream.Create;
2967 end;
2968 
2969 {$IFDEF WITH_FTDATASETSUPPORT}
2970 function TZAbstractRODataset.CreateNestedDataSet(DataSetField: TDataSetField): TDataSet;
2971 begin
2972  Result := inherited CreateNestedDataSet(DataSetField);
2973 end;
2974 {$ENDIF}
2975 
2976 {**
2977  Closes the specified BLOB field.
2978  @param a BLOB field object.
2979 }
2980 procedure TZAbstractRODataset.CloseBlob(Field: TField);
2981 begin
2982 end;
2983 
2984 {**
2985  Closes the cursor-handles. Releases(not closing) the current resultset
2986  and opens the cursorhandles. The current statment is used further.
2987  @param the NewResultSet
2988 }
2989 procedure TZAbstractRODataset.SetAnotherResultset(const Value: IZResultSet);
2990 begin
2991  {EgonHugeist: I was forced to go this stupid sequence
2992  first i wanted to exclude parts of InternalOpen/Close but this didn't solve
2993  the DataSet issues. You can't init the fields as long the Cursor is not
2994  closed.. Which is equal to cursor open}
2995  if Assigned(Value) and ( Value <> ResultSet ) then
2996  begin
2997  FDoNotCloseResultSet := True; //hint for InternalClose
2998  SetState(dsInactive);
2999  CloseCursor; //Calls InternalOpen in his sequence so InternalClose must be prepared
3000  FDoNotCloseResultSet := False; //reset hint for InternalClose
3001  ResultSet := Value; //Assign the new resultset
3002  if not ResultSet.IsBeforeFirst then
3003  ResultSet.BeforeFirst; //need this. All from dataset buffered resultsets are EOR
3004  FUseCurrentStatment := True; //hint for InternalOpen
3005  OpenCursor{$IFDEF FPC}(False){$ENDIF}; //Calls InternalOpen in his sequence so InternalOpen must be prepared
3006  OpenCursorComplete; //set DataSet to dsActive
3007  FUseCurrentStatment := False; //reset hint for InternalOpen
3008  end;
3009 end;
3010 
3011 {**
3012  Performs sorting of the internal rows.
3013 }
3014 procedure TZAbstractRODataset.InternalSort;
3015 var
3016  I, RowNo: Integer;
3017  SavedRowBuffer: PZRowBuffer;
3018 begin
3019  if FIndexFieldNames = '' then exit; {bangfauzan addition}
3020  if (ResultSet <> nil) and not IsUniDirectional then
3021  begin
3022  FIndexFieldNames := Trim(FIndexFieldNames); {bangfauzan modification}
3023  DefineSortedFields(Self, {FSortedFields} FIndexFieldNames {bangfauzan modification},
3024  FSortedFieldRefs, FSortedFieldDirs, FSortedOnlyDataFields);
3025 
3026  if (CurrentRow <= CurrentRows.Count) and (CurrentRows.Count > 0)
3027  and (CurrentRow > 0) then
3028  RowNo := Integer(CurrentRows[CurrentRow - 1])
3029  else
3030  RowNo := -1;
3031 
3032  { Restores the previous order. }
3033  if Length(FSortedFieldRefs) = 0 then
3034  begin
3035  CurrentRows.Sort(ClearSort);
3036  end
3037  else
3038  begin
3039  FetchRows(0);
3040  if FSortedOnlyDataFields then
3041  begin
3042  { Converts field objects into field indices. }
3043  SetLength(FSortedFieldIndices, Length(FSortedFieldRefs));
3044  for I := 0 to High(FSortedFieldRefs) do
3045  FSortedFieldIndices[I] := TField(FSortedFieldRefs[I]).FieldNo;
3046  { Performs a sorting. }
3047  CurrentRows.Sort(LowLevelSort);
3048  end
3049  else
3050  begin
3051  SavedRowBuffer := RowAccessor.RowBuffer;
3052  { Sorts using generic highlevel approach. }
3053  try
3054  { Allocates buffers for sorting. }
3055  RowAccessor.AllocBuffer(FSortRowBuffer1);
3056  RowAccessor.AllocBuffer(FSortRowBuffer2);
3057  { Converts field objects into field indices. }
3058  SetLength(FSortedFieldIndices, Length(FSortedFieldRefs));
3059  for I := 0 to High(FSortedFieldRefs) do
3060  begin
3061  FSortedFieldIndices[I] := DefineFieldIndex(FieldsLookupTable,
3062  TField(FSortedFieldRefs[I]));
3063  end;
3064  { Performs sorting. }
3065  CurrentRows.Sort(HighLevelSort);
3066  finally
3067  { Disposed buffers for sorting. }
3068  RowAccessor.DisposeBuffer(FSortRowBuffer1);
3069  RowAccessor.DisposeBuffer(FSortRowBuffer2);
3070  RowAccessor.RowBuffer := SavedRowBuffer;
3071  end;
3072  end;
3073  end;
3074 
3075  CurrentRow := CurrentRows.IndexOf(Pointer(RowNo)) + 1;
3076  CurrentRow := Min(Max(0, CurrentRow), CurrentRows.Count);
3077  if not (State in [dsInactive]) then
3078  Resync([]);
3079  end;
3080 end;
3081 
3082 {**
3083  Clears list sorting and restores the previous order.
3084  @param Item1 a reference to the first row.
3085  @param Item2 a reference to the second row.
3086  @returns &gt;0 if Item1 &gt; Item2, &lt;0 it Item1 &lt; Item2 and 0
3087  if Item1 and Item2 are equal.
3088 }
3089 function TZAbstractRODataset.ClearSort(Item1, Item2: Pointer): Integer;
3090 begin
3091  Result := Integer(Item1) - Integer(Item2);
3092 end;
3093 
3094 {**
3095  Sorting list using generic approach which is slow but may be used
3096  with calculated fields.
3097 
3098  @param Item1 a reference to the first row.
3099  @param Item2 a reference to the second row.
3100  @returns &gt;0 if Item1 &gt; Item2, &lt;0 it Item1 &lt; Item2 and 0
3101  if Item1 and Item2 are equal.
3102 }
3103 function TZAbstractRODataset.HighLevelSort(Item1, Item2: Pointer): Integer;
3104 var
3105  RowNo: Integer;
3106 begin
3107  { Gets the first row. }
3108  RowNo := Integer(Item1);
3109  ResultSet.MoveAbsolute(RowNo);
3110  RowAccessor.RowBuffer := FSortRowBuffer1;
3111  RowAccessor.RowBuffer^.Index := RowNo;
3112  FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
3113  FRowAccessor.RowBuffer^.BookmarkFlag := Ord(bfCurrent);
3114 {$IFDEF WITH_TRECORDBUFFER}
3115  GetCalcFields({$IFDEF WITH_GETCALCFIELDS_TRECBUF}NativeInt{$ELSE}TRecordBuffer{$ENDIF}(FSortRowBuffer1));
3116 {$ELSE}
3117  GetCalcFields(PChar(FSortRowBuffer1));
3118 {$ENDIF}
3119 
3120  { Gets the second row. }
3121  RowNo := Integer(Item2);
3122  ResultSet.MoveAbsolute(RowNo);
3123  RowAccessor.RowBuffer := FSortRowBuffer2;
3124  RowAccessor.RowBuffer^.Index := RowNo;
3125  FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
3126  FRowAccessor.RowBuffer^.BookmarkFlag := Ord(bfCurrent);
3127 {$IFDEF WITH_TRECORDBUFFER}
3128  GetCalcFields({$IFDEF WITH_GETCALCFIELDS_TRECBUF}NativeInt{$ELSE}TRecordBuffer{$ENDIF}(FSortRowBuffer2));
3129 {$ELSE}
3130  GetCalcFields(PChar(FSortRowBuffer2));
3131 {$ENDIF}
3132 
3133  { Compare both records. }
3134  Result := RowAccessor.CompareBuffers(FSortRowBuffer1, FSortRowBuffer2,
3135  FSortedFieldIndices, FSortedFieldDirs);
3136 end;
3137 
3138 {**
3139  Sorting list using lowlevel approach which is fast but may not be used
3140  with calculated fields.
3141 
3142  @param Item1 a reference to the first row.
3143  @param Item2 a reference to the second row.
3144  @returns &gt;0 if Item1 &gt; Item2, &lt;0 it Item1 &lt; Item2 and 0
3145  if Item1 and Item2 are equal.
3146 }
3147 function TZAbstractRODataset.LowLevelSort(Item1, Item2: Pointer): Integer;
3148 begin
3149  Result := ResultSet.CompareRows(Integer(Item1), Integer(Item2),
3150  FSortedFieldIndices, FSortedFieldDirs);
3151 end;
3152 
3153 {**
3154  Sets a new dataset properties.
3155  @param Value a dataset properties.
3156 }
3157 procedure TZAbstractRODataset.SetProperties(const Value: TStrings);
3158 begin
3159  FProperties.Assign(Value);
3160 end;
3161 
3162 {$IFDEF WITH_IPROVIDER}
3163 
3164 {**
3165  Starts a new transaction.
3166 }
3167 procedure TZAbstractRODataset.PSStartTransaction;
3168 begin
3169  if Assigned(FConnection) and not FConnection.AutoCommit then
3170  begin
3171  if not FConnection.Connected then
3172  FConnection.Connect;
3173  FConnection.StartTransaction;
3174  end;
3175 end;
3176 
3177 {**
3178  Completes previously started transaction.
3179  @param Commit a commit transaction flag.
3180 }
3181 procedure TZAbstractRODataset.PSEndTransaction(Commit: Boolean);
3182 begin
3183  if Assigned(FConnection) and FConnection.Connected
3184  and not FConnection.AutoCommit then
3185  begin
3186  if Commit then
3187  FConnection.Commit
3188  else
3189  FConnection.Rollback;
3190  end;
3191 end;
3192 
3193 {**
3194  Checks if this query is in transaction mode.
3195  @returns <code>True</code> if query in transaction.
3196 }
3197 function TZAbstractRODataset.PSInTransaction: Boolean;
3198 begin
3199  Result := Assigned(FConnection) and FConnection.Connected
3200  and (FConnection.TransactIsolationLevel <> tiNone)
3201  and not FConnection.AutoCommit;
3202 end;
3203 
3204 {**
3205  Returns a string quote character.
3206  @retuns a quote character.
3207 }
3208 {$IFDEF WITH_IPROVIDERWIDE}
3209 function TZAbstractRODataset.PSGetQuoteCharW: WideString;
3210 {$ELSE}
3211 function TZAbstractRODataset.PSGetQuoteChar: string;
3212 {$ENDIF}
3213 begin
3214  if Assigned(FConnection) then
3215  begin
3216  if not FConnection.Connected then
3217  FConnection.Connect;
3218  Result := FConnection.DbcConnection.GetMetadata.GetDatabaseInfo.GetIdentifierQuoteString;
3219  if Length(Result) > 1 then
3220  Result := Copy(Result, 1, 1);
3221  end
3222  else
3223  Result := '"';
3224 end;
3225 
3226 {**
3227  Checks if dataset can execute any commands?
3228  @returns <code>True</code> if the query can execute any commands.
3229 }
3230 function TZAbstractRODataset.PSIsSQLSupported: Boolean;
3231 begin
3232  Result := True;
3233 end;
3234 
3235 {**
3236  Checks if dataset can execute SQL queries?
3237  @returns <code>True</code> if the query can execute SQL.
3238 }
3239 function TZAbstractRODataset.PSIsSQLBased: Boolean;
3240 begin
3241  Result := True;
3242 end;
3243 
3244 {**
3245  Resets this dataset.
3246 }
3247 procedure TZAbstractRODataset.PSReset;
3248 begin
3249  inherited PSReset;
3250  if Active then
3251  begin
3252  Refresh;
3253  First;
3254  end;
3255 end;
3256 
3257 {**
3258  Execute statement a SQL query.
3259 }
3260 procedure TZAbstractRODataset.PSExecute;
3261 begin
3262  ExecSQL;
3263 end;
3264 
3265 {**
3266  Gets query parameters.
3267  @returns parameters of this query.
3268 }
3269 function TZAbstractRODataset.PSGetParams: TParams;
3270 begin
3271  Result := Params;
3272 end;
3273 
3274 {**
3275  Set new query parameters
3276  @param AParams new parameters to set into this query.
3277 }
3278 procedure TZAbstractRODataset.PSSetParams(AParams: TParams);
3279 begin
3280  if AParams.Count > 0 then
3281  Params.Assign(AParams);
3282 end;
3283 
3284 {**
3285  Sets a command text for this query to execute.
3286  @param CommandText a command text for this query.
3287 }
3288 
3289 {$IFDEF WITH_IPROVIDERWIDE}
3290 procedure TZAbstractRODataset.PSSetCommandText(const CommandText: string);
3291 begin
3292  SQL.Text := CommandText;
3293 end;
3294 
3295 procedure TZAbstractRODataset.PSSetCommandText(const CommandText: WideString);
3296 {$ELSE}
3297 procedure TZAbstractRODataset.PSSetCommandText(const CommandText: string);
3298 {$ENDIF}
3299 begin
3300  SQL.Text := CommandText;
3301 end;
3302 
3303 {**
3304  Updates a record in the specified dataset.
3305  @param UpdateKind a type of the update.
3306  @param Delta a dataset with updates.
3307 }
3308 function TZAbstractRODataset.PSUpdateRecord(UpdateKind: TUpdateKind;
3309  Delta: TDataSet): Boolean;
3310 begin
3311  Result := False;
3312 end;
3313 
3314 {**
3315  Generates an EUpdateError object based on another exception object.
3316  @param E occured exception.
3317  @param Prev a previous update error.
3318  @returns a new created update error.
3319 }
3320 function TZAbstractRODataset.PSGetUpdateException(E: Exception;
3321  Prev: EUpdateError): EUpdateError;
3322 var
3323  PrevErrorCode: Integer;
3324 begin
3325  if E is EZSQLException then
3326  begin
3327  if Assigned(Prev) then
3328  PrevErrorCode := Prev.ErrorCode
3329  else
3330  PrevErrorCode := 0;
3331 
3332  Result := EUpdateError.Create(E.Message, '',
3333  EZSQLException(E).ErrorCode, PrevErrorCode, E);
3334  end
3335  else
3336  Result := EUpdateError.Create(E.Message, '', -1, -1, E);
3337 end;
3338 
3339 {**
3340  Gets a table name if table is only one in the SELECT SQL statement.
3341  @returns a table name or an empty string is SQL query is complex SELECT
3342  or not SELECT statement.
3343 }
3344 {$IFDEF WITH_IPROVIDERWIDE}
3345 function TZAbstractRODataset.PSGetTableNameW: WideString;
3346 {$ELSE}
3347 function TZAbstractRODataset.PSGetTableName: string;
3348 {$ENDIF}
3349 var
3350  Driver: IZDriver;
3351  Tokenizer: IZTokenizer;
3352  StatementAnalyser: IZStatementAnalyser;
3353  SelectSchema: IZSelectSchema;
3354 begin
3355  Result := '';
3356  if FConnection <> nil then
3357  begin
3358  Driver := FConnection.DbcDriver;
3359  Tokenizer := Driver.GetTokenizer;
3360  StatementAnalyser := Driver.GetStatementAnalyser;
3361  SelectSchema := StatementAnalyser.DefineSelectSchemaFromQuery(
3362  Tokenizer, SQL.Text);
3363  if Assigned(SelectSchema) and (SelectSchema.TableCount = 1) then
3364  Result := SelectSchema.Tables[0].FullName;
3365  end;
3366 end;
3367 
3368 {**
3369  Defines a list of query primary key fields.
3370  @returns a semicolon delimited list of query key fields.
3371 }
3372 // Silvio Clecio
3373 {$IFDEF WITH_IPROVIDERWIDE}
3374 {$WARNINGS OFF}
3375 function TZAbstractRODataset.PSGetKeyFieldsW: WideString;
3376 begin
3377  Result := inherited PSGetKeyFieldsW;
3378 end;
3379 {$WARNINGS ON}
3380 {$ELSE}
3381 function TZAbstractRODataset.PSGetKeyFields: string;
3382 begin
3383  Result := inherited PSGetKeyFields;
3384 end;
3385 {$ENDIF}
3386 
3387 {**
3388  Executes a SQL statement with parameters.
3389  @param ASQL a SQL statement with parameters defined with question marks.
3390  @param AParams a collection of statement parameters.
3391  @param ResultSet a supplied result set reference (just ignored).
3392  @returns a number of updated rows.
3393 }
3394 
3395 {$IFDEF WITH_IPROVIDERWIDE}
3396 function TZAbstractRODataset.PSExecuteStatement(const ASQL: WideString; AParams: TParams;
3397  ResultSet: Pointer = nil): Integer;
3398 {$ELSE}
3399 function TZAbstractRODataset.PSExecuteStatement(const ASQL: string;
3400  AParams: TParams; ResultSet: Pointer): Integer;
3401 {$ENDIF}
3402 var
3403  I: Integer;
3404  Statement: IZPreparedStatement;
3405  ParamValue: TParam;
3406 begin
3407  if Assigned(FConnection) then
3408  begin
3409  if not FConnection.Connected then
3410  FConnection.Connect;
3411  Statement := FConnection.DbcConnection.PrepareStatement(ASQL);
3412  if (AParams <> nil) and (AParams.Count > 0) then
3413  for I := 0 to AParams.Count - 1 do
3414  begin
3415  ParamValue := AParams[I];
3416  SetStatementParam(I+1, Statement, ParamValue);
3417  end;
3418  Result := Statement.ExecuteUpdatePrepared;
3419  end
3420  else
3421  Result := 0;
3422 end;
3423 
3424 {$ENDIF}
3425 
3426 procedure TZAbstractRODataset.CheckFieldCompatibility(Field: TField;FieldDef: TFieldDef);
3427 const
3428  {EH: hint all commented types are the fields the RowAccessor can't handle -> avoid stack killing moves in Get/SetFieldData()
3429  this Error trapping is made for User-added fields like calulateds ....}
3430  BaseFieldTypes: array[TFieldType] of TFieldType = (
3431  //generic TFieldTypes of FPC and Delphi(since D7, of course):
3432  ftUnknown, ftString, ftSmallint, ftInteger, ftWord, // 0..4
3433  ftBoolean, ftFloat, ftCurrency, ftFloat{ftBCD}, ftDate, ftTime, ftDateTime, // 5..11
3434  ftBytes, ftBytes{ftVarBytes}, ftInteger{ftAutoInc}, ftBlob, ftMemo, ftBlob{ftGraphic}, ftMemo{ftFmtMemo}, // 12..18
3435  ftBlob{ftParadoxOle}, ftBlob{ftDBaseOle}, ftBlob{ftTypedBinary}, ftUnknown{ftCursor}, ftString{ftFixedChar}, ftWideString, // 19..24
3436  ftLargeint, ftUnknown{ftADT}, ftUnknown{ftArray}, ftUnknown{ftReference}, ftDataSet, ftBlob{ftOraBlob}, ftMemo{ftOraClob}, // 25..31
3437  ftUnknown{ftVariant}, ftUnknown{ftInterface}, ftUnknown{ftIDispatch}, ftGuid, ftTimeStamp, ftFloat{ftFMTBcd} // 32..37
3438 {$IFDEF FPC} //addition types for FPC
3439  , ftWideString{ftFixedWideChar}, ftWideMemo // 38..39
3440 {$ELSE !FPC}
3441 {$IF CompilerVersion >= 18} //additional Types since D2006 and D2007
3442  , ftWideString{ftFixedWideChar}, ftWideMemo, ftDateTime{ftOraTimeStamp}, ftDateTime{ftOraInterval} // 38..41
3443 {$IF CompilerVersion >= 20} //additional Types since D2009
3444  , ftLongWord, ftShortint, ftByte, ftExtended, ftUnknown{ftConnection}, ftUnknown{ftParams}, ftBlob{ftStream} //42..48
3445 {$IF CompilerVersion >= 21} //additional Types since D2010
3446  , ftDateTime{ftTimeStampOffset}, ftUnknown{ftObject}, ftSingle //49..51
3447 {$IFEND CompilerVersion >= 21}
3448 {$IFEND CompilerVersion >= 20}
3449 {$IFEND CompilerVersion >= 18}
3450 {$ENDIF FPC}
3451  );
3452  CheckTypeSizes = [ftBytes, ftVarBytes, ftBCD, ftReference];
3453 begin
3454  with Field do
3455  begin
3456  if (BaseFieldTypes[DataType] <> BaseFieldTypes[FieldDef.DataType]) then
3457  DatabaseErrorFmt(SFieldTypeMismatch, [DisplayName,
3458  FieldTypeNames[DataType], FieldTypeNames[FieldDef.DataType]], Self);
3459  if (DataType in CheckTypeSizes) and (Size <> FieldDef.Size) then
3460  DatabaseErrorFmt(SFieldSizeMismatch, [DisplayName, Size,
3461  FieldDef.Size], Self);
3462  end;
3463 end;
3464 
3465 {**
3466  Reset the calculated (includes fkLookup) fields
3467  @param Buffer
3468 }
3469 
3470 {$IFDEF WITH_TRECORDBUFFER}
3471 
3472 procedure TZAbstractRODataset.ClearCalcFields(Buffer: TRecordBuffer);
3473 {$ELSE}
3474 
3475 procedure TZAbstractRODataset.ClearCalcFields(Buffer: PChar);
3476 {$ENDIF}
3477 var
3478  Index: Integer;
3479 begin
3480  RowAccessor.RowBuffer := PZRowBuffer(Buffer);
3481  for Index := 1 to Fields.Count do
3482  if (Fields[Index-1].FieldKind in [fkCalculated, fkLookup]) then
3483  RowAccessor.SetNull(DefineFieldindex(FFieldsLookupTable,Fields[Index-1]));
3484 end;
3485 
3486 {=======================bangfauzan addition========================}
3487 function TZAbstractRODataset.GetSortType: TSortType;
3488 var
3489  AscCount, DescCount: Integer;
3490  s: String;
3491 begin
3492  {pawelsel modification}
3493  AscCount:=0;
3494  DescCount:=0;
3495  s:=StringReplace(FIndexFieldNames,';',',',[rfReplaceAll]);
3496  while Pos(',',s)>0 do
3497  begin
3498  if Pos(' DESC',UpperCase(Copy(s,1,Pos(',',s))))>0 then
3499  Inc(DescCount)
3500  else
3501  Inc(AscCount);
3502  s:=Copy(s,Pos(',',s)+1,Length(s)-Pos(',',s));
3503  end;
3504  if Length(s)>0 then
3505  if Pos(' DESC',UpperCase(s))>0 then
3506  Inc(DescCount)
3507  else
3508  Inc(AscCount);
3509  if (DescCount > 0) and (AscCount > 0) then
3510  Result:=stIgnored
3511  else if (DescCount > 0) then
3512  Result:=stDescending
3513  else
3514  Result:=stAscending;
3515 end;
3516 
3517 procedure TZAbstractRODataset.SetSortType(Value: TSortType);
3518 begin
3519  if FSortType <> Value then
3520  begin
3521  FSortType := Value;
3522  if (FSortType <> stIgnored) then
3523  begin {pawelsel modification}
3524  FSortedFields:=StringReplace(FSortedFields,' Desc','',[rfReplaceAll,rfIgnoreCase]);
3525  FSortedFields:=StringReplace(FSortedFields,' Asc','',[rfReplaceAll,rfIgnoreCase]);
3526  end;
3527  FIndexFieldNames:=GetIndexFieldNames;
3528  if Active then
3529  if (FSortedFields = '') then
3530  Self.InternalRefresh
3531  else
3532  InternalSort;
3533  end;
3534 end;
3535 
3536 function TZAbstractRODataset.GetIndexFieldNames : String;
3537 begin
3538  Result:=FSortedFields;
3539  if Result <> '' then
3540  begin {pawelsel modification}
3541  if FSortType = stAscending then
3542  begin
3543  Result:=StringReplace(Result,';',' Asc;',[rfReplaceAll]);
3544  Result:=StringReplace(Result,',',' Asc,',[rfReplaceAll]);
3545  Result:=Result+' Asc';
3546  end;
3547  if FSortType = stDescending then
3548  begin
3549  Result:=StringReplace(Result,';',' Desc;',[rfReplaceAll]);
3550  Result:=StringReplace(Result,',',' Desc,',[rfReplaceAll]);
3551  Result:=Result+' Desc';
3552  end;
3553  end;
3554 end;
3555 
3556 procedure TZAbstractRODataset.SetIndexFieldNames(Value: String);
3557 begin
3558  Value:=Trim(Value);
3559  {pawelsel modification}
3560  Value:=StringReplace(Value,'[','',[rfReplaceAll]);
3561  Value:=StringReplace(Value,']','',[rfReplaceAll]);
3562 
3563  if FIndexFieldNames <> Value then
3564  begin
3565  FIndexFieldNames := Value;
3566  FSortType:=GetSortType;
3567  if (FSortType <> stIgnored) then
3568  begin {pawelsel modification}
3569  Value:=StringReplace(Value,' Desc','',[rfReplaceAll,rfIgnoreCase]);
3570  Value:=StringReplace(Value,' Asc','',[rfReplaceAll,rfIgnoreCase]);
3571  end;
3572  FSortedFields:=Value;
3573  end;
3574 
3575  {Perform sorting}
3576  if Active then
3577  if (FSortedFields = '') then
3578  Self.InternalRefresh
3579  else
3580  InternalSort;
3581 end;
3582 
3583 {====================end of bangfauzan addition====================}
3584 
3585 end.
3586 
3587 
3588