1 {*********************************************************}
3 { Zeos Database Objects }
4 { Abstract Read/Only Dataset component }
6 { Originally written by Sergey Seroukhov }
8 {*********************************************************}
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
13 { License Agreement: }
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. }
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. }
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) }
46 { http://www.sourceforge.net/projects/zeoslib. }
49 { Zeos Development Group. }
50 {********************************************************@}
52 unit ZAbstractRODataset;
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};
69 {$IFDEF xFPC} // fixed in r3943 or earlier 2006-06-25
70 TUpdateStatusSet = set of TUpdateStatus;
72 EUpdateError = class(EDatabaseError)
76 TSortType = (stAscending, stDescending, stIgnored); {bangfauzan addition}
78 {** Options for dataset. }
79 TZDatasetOption = (doOemTranslate, doCalcDefaults, doAlwaysDetailResync,
80 doSmartOpen, doPreferPrepared, doDontSortOnPost, doUpdateMasterFirst);
82 {** Set of dataset options. }
83 TZDatasetOptions = set of TZDatasetOption;
85 // Forward declarations.
86 TZAbstractRODataset = class;
88 {** Implements a Zeos specific database exception with SQL error code. }
89 EZDatabaseError = class(EDatabaseError)
93 procedure SetStatusCode(const Value: String);
95 constructor Create(const Msg: string);
96 constructor CreateFromException(E: EZSQLThrowable);
98 property ErrorCode: Integer read FErrorCode write FErrorCode;
99 property StatusCode: String read FStatusCode write SetStatusCode;
102 {** Dataset Linker class. }
103 TZDataLink = class(TMasterDataLink)
105 FDataset: TZAbstractRODataset;
107 procedure ActiveChanged; override;
108 procedure RecordChanged(Field: TField); override;
110 constructor Create(ADataset: TZAbstractRODataset); {$IFDEF FPC}reintroduce;{$ENDIF}
113 {** Abstract dataset component optimized for read/only access. }
114 {$IFDEF WITH_WIDEDATASET}
115 TZAbstractRODataset = class(TWideDataSet)
117 TZAbstractRODataset = class(TDataSet)
120 {$IFNDEF WITH_FUNIDIRECTIONAL}
121 FUniDirectional: Boolean;
123 FCurrentRow: Integer;
124 FRowAccessor: TZRowAccessor;
125 FOldRowBuffer: PZRowBuffer;
126 FNewRowBuffer: PZRowBuffer;
127 FCurrentRows: TZSortedList;
128 FFetchCount: Integer;
129 FFieldsLookupTable: TIntegerDynArray;
130 FRowsAffected: Integer;
132 FFilterEnabled: Boolean;
133 FFilterExpression: IZExpression;
134 FFilterStack: TZExecutionStack;
135 FFilterFieldRefs: TObjectDynArray;
136 FInitFilterFields: Boolean;
138 FRequestLive: Boolean;
139 FFetchRow: integer; // added by Patyi
143 FShowRecordTypes: TUpdateStatusSet;
144 FOptions: TZDatasetOptions;
146 FProperties: TStrings;
147 FConnection: TZAbstractConnection;
148 FStatement: IZPreparedStatement;
149 FResultSet: IZResultSet;
151 FRefreshInProgress: Boolean;
153 FDataLink: TDataLink;
154 FMasterLink: TMasterDataLink;
155 FLinkedFields: string; {renamed by bangfauzan}
156 FIndexFieldNames : String; {bangfauzan addition}
158 FIndexFields: {$IFDEF WITH_GENERIC_TLISTTFIELD}TList<TField>{$ELSE}TList{$ENDIF};
160 FSortType : TSortType; {bangfauzan addition}
162 FSortedFields: string;
163 FSortedFieldRefs: TObjectDynArray;
164 FSortedFieldIndices: TIntegerDynArray;
165 FSortedFieldDirs: TBooleanDynArray;
166 FSortedOnlyDataFields: Boolean;
167 FSortRowBuffer1: PZRowBuffer;
168 FSortRowBuffer2: PZRowBuffer;
170 FDoNotCloseResultset: Boolean;
171 FUseCurrentStatment: Boolean;
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);
198 function GetSortType : TSortType; {bangfauzan addition}
199 Procedure SetSortType(Value : TSortType); {bangfauzan addition}
201 procedure UpdateSQLStrings(Sender: TObject);
202 procedure ReadParamData(Reader: TReader);
203 procedure WriteParamData(Writer: TWriter);
205 procedure SetPrepared(Value : Boolean);
206 {$IFNDEF WITH_FUNIDIRECTIONAL}
207 procedure SetUniDirectional(const Value: boolean);
209 function GetUniDirectional: boolean;
212 procedure CheckOpened;
213 procedure CheckConnected;
214 procedure CheckBiDirectional;
215 procedure CheckSQLQuery; virtual;
216 procedure RaiseReadOnlyError;
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;
230 function GetDataSource: TDataSource; override;
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;
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;
252 property Statement: IZPreparedStatement read FStatement write FStatement;
253 property ResultSet: IZResultSet read FResultSet write FResultSet;
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;
259 { External protected properties. }
260 property RequestLive: Boolean read FRequestLive write FRequestLive
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
266 property ParamChar: Char read GetParamChar write SetParamChar
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;
288 { Abstracts methods }
289 procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
290 procedure InternalDelete; override;
291 procedure InternalPost; override;
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;
298 {$IFDEF WITH_TRECORDBUFFER}
299 function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean):
300 TGetResult; override;
302 function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean):
303 TGetResult; override;
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;
311 function AllocRecordBuffer: PChar; override;
312 procedure FreeRecordBuffer(var Buffer: PChar); override;
314 {$IFDEF WITH_FTDATASETSUPPORT}
315 function CreateNestedDataSet(DataSetField: TDataSetField): TDataSet; override;
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;
323 procedure CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef); {$IFDEF WITH_CHECKFIELDCOMPATIBILITY} override;{$ENDIF}
324 {$IFDEF WITH_TRECORDBUFFER}
325 procedure ClearCalcFields(Buffer: TRecordBuffer); override;
327 procedure ClearCalcFields(Buffer: PChar); override;
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;
338 procedure InternalInitRecord(Buffer: PChar); override;
340 procedure InternalGotoBookmark(Bookmark: Pointer); override;
341 procedure InternalRefresh; override;
342 procedure InternalHandleException; override;
343 {$IFDEF WITH_TRECORDBUFFER}
344 procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
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;
353 procedure InternalSetToRecord(Buffer: PChar); override;
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;
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;
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;
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;
379 procedure Notification(AComponent: TComponent;
380 Operation: TOperation); override;
382 procedure RefreshParams; virtual;
384 procedure InternalPrepare; virtual;
385 procedure InternalUnPrepare; virtual;
387 {$IFDEF WITH_IPROVIDER}
388 procedure PSStartTransaction; override;
389 procedure PSEndTransaction(Commit: Boolean); override;
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;
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;
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;
422 constructor Create(AOwner: TComponent); override;
423 destructor Destroy; override;
425 procedure FetchAll; virtual; // added by Patyi
426 procedure ExecSQL; virtual;
427 function RowsAffected: LongInt;
428 function ParamByName(const Value: string): TParam;
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;
436 function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
438 function BookmarkValid(Bookmark: TBookmark): Boolean; override;
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;
445 function UpdateStatus: TUpdateStatus; override;
446 function Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; override;
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;
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}
463 property AutoCalcFields;
466 property BeforeClose;
468 property BeforeRefresh;
469 property AfterRefresh;
470 property BeforeScroll;
471 property AfterScroll;
472 property OnCalcFields;
473 property OnFilterRecord;
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};
489 Constructs a database exception with a string message.
490 @param Msg a string message which describes the error.
492 constructor EZDatabaseError.Create(const Msg: string);
494 inherited Create(Msg);
498 Constructs a database exception from TZSQLThrowable instance.
499 @param E an original TZSQLThrowable instance.
501 constructor EZDatabaseError.CreateFromException(E: EZSQLThrowable);
503 inherited Create(E.Message);
504 ErrorCode := E.ErrorCode;
505 Statuscode:= E.StatusCode;
508 procedure EZDatabaseError.SetStatusCode(const Value: String);
510 FStatusCode := value;
516 Creates this dataset link object.
517 @param ADataset an owner linked dataset component.
519 constructor TZDataLink.Create(ADataset: TZAbstractRODataset);
521 inherited Create(ADataset);
522 FDataset := ADataset;
526 Processes changes in state of linked dataset.
528 procedure TZDataLink.ActiveChanged;
530 if FDataset.Active then
531 FDataset.RefreshParams;
535 Processes changes in fields of the linked dataset.
536 @param Field a field which was changed.
538 procedure TZDataLink.RecordChanged(Field: TField);
540 if (Field = nil) and FDataset.Active then
541 FDataset.RefreshParams;
544 { TZAbstractRODataset }
547 Constructs this object and assignes the mail properties.
548 @param AOwner a component owner.
550 constructor TZAbstractRODataset.Create(AOwner: TComponent);
552 inherited Create(AOwner);
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];
566 FFilterEnabled := False;
567 FProperties := TStringList.Create;
568 FFilterExpression := TZExpression.Create;
569 FFilterExpression.Tokenizer := CommonTokenizer;
570 FFilterStack := TZExecutionStack.Create;
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;
579 FIndexFields := TList.Create;
584 Destroys this object and cleanups the memory.
586 destructor TZAbstractRODataset.Destroy;
589 if Assigned(Connection) then
599 FreeAndNil(FCurrentRows);
600 FreeAndNil(FProperties);
601 FreeAndNil(FFilterStack);
603 FreeAndNil(FDataLink);
604 FreeAndNil(FMasterLink);
605 FreeAndNil(FIndexFields);
611 Sets database connection object.
612 @param Value a database connection object.
614 procedure TZAbstractRODataset.SetConnection(Value: TZAbstractConnection);
616 if FConnection <> Value then
621 if FConnection <> nil then
622 FConnection.UnregisterDataSet(Self);
623 FConnection := Value;
624 if FConnection <> nil then
625 FConnection.RegisterDataSet(Self);
631 @return the SQL query strings.
634 function TZAbstractRODataset.GetSQL: TStrings;
639 {$IFNDEF WITH_FUNIDIRECTIONAL}
640 function TZAbstractRODataset.SetUniDirectional(const Value: boolean);
642 FUniDirectional := Value;
646 Gets unidirectional state of dataset.
647 @return the unidirectional flag (delphi).
649 function TZAbstractRODataset.GetUniDirectional: boolean;
651 Result := {$IFNDEF WITH_FUNIDIRECTIONAL}FUniDirectional{$ELSE}inherited IsUniDirectional{$ENDIF};
655 Sets a new SQL query.
656 @param Value a new SQL query.
658 procedure TZAbstractRODataset.SetSQL(Value: TStrings);
664 Gets a parameters check value.
665 @return a parameters check value.
667 function TZAbstractRODataset.GetParamCheck: Boolean;
669 Result := FSQL.ParamCheck;
673 Sets a new parameters check value.
674 @param Value a parameters check value.
676 procedure TZAbstractRODataset.SetParamCheck(Value: Boolean);
678 FSQL.ParamCheck := Value;
679 UpdateSQLStrings(Self);
683 Gets a parameters marker.
684 @return a parameter marker.
686 function TZAbstractRODataset.GetParamChar: Char;
688 Result := FSQL.ParamChar;
692 Sets a new parameter marker.
693 @param Value a parameter marker.
695 procedure TZAbstractRODataset.SetParamChar(Value: Char);
697 FSQL.ParamChar := Value;
698 UpdateSQLStrings(Self);
702 Sets a new set of parameters.
703 @param Value a set of parameters.
705 procedure TZAbstractRODataset.SetParams(Value: TParams);
707 FParams.AssignValues(Value);
711 Defines a persistent dataset properties.
712 @param Filer a persistent manager object.
714 procedure TZAbstractRODataset.DefineProperties(Filer: TFiler);
716 function WriteData: Boolean;
718 if Filer.Ancestor <> nil then
719 Result := not FParams.IsEqual(TZAbstractRODataset(Filer.Ancestor).FParams)
721 Result := FParams.Count > 0;
725 inherited DefineProperties(Filer);
726 Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
730 Reads parameter data from persistent storage.
731 @param Reader an input data stream.
733 procedure TZAbstractRODataset.ReadParamData(Reader: TReader);
736 Reader.ReadCollection(FParams);
740 Writes parameter data from persistent storage.
741 @param Writer an output data stream.
743 procedure TZAbstractRODataset.WriteParamData(Writer: TWriter);
745 Writer.WriteCollection(Params);
749 Gets a SQL parameter by its name.
750 @param Value a parameter name.
751 @return a found parameter object.
753 function TZAbstractRODataset.ParamByName(const Value: string): TParam;
755 Result := FParams.ParamByName(Value);
759 Updates parameters from SQL statement.
760 @param Sender an event sender object.
762 procedure TZAbstractRODataset.UpdateSQLStrings(Sender: TObject);
772 if assigned(Statement) then
779 OldParams := TParams.Create;
780 OldParams.Assign(FParams);
784 for I := 0 to FSQL.ParamCount - 1 do
785 FParams.CreateParam(ftUnknown, FSQL.ParamNames[I], ptUnknown);
786 FParams.AssignValues(OldParams);
793 Gets the ReadOnly property.
794 @return <code>True</code> if the opened result set read only.
796 function TZAbstractRODataset.GetReadOnly: Boolean;
798 Result := not RequestLive;
802 Sets a new ReadOnly property.
803 @param Value <code>True</code> to set result set read-only.
805 procedure TZAbstractRODataset.SetReadOnly(Value: Boolean);
807 RequestLive := not Value;
811 Gets a visible updated records types.
812 @param return visible UpdateRecordTypes value.
814 function TZAbstractRODataset.GetShowRecordTypes: TUpdateStatusSet;
816 Result := FShowRecordTypes;
820 Sets a new visible updated records types.
821 @param Value a new visible UpdateRecordTypes value.
823 procedure TZAbstractRODataset.SetShowRecordTypes(Value: TUpdateStatusSet);
825 if Value <> FShowRecordTypes then
827 FShowRecordTypes := Value;
833 Checks if this dataset is opened.
835 procedure TZAbstractRODataset.CheckOpened;
838 DatabaseError(SOperationIsNotAllowed4);
842 Checks if the database connection is assigned
843 and tries to connect.
845 procedure TZAbstractRODataset.CheckConnected;
847 if Connection = nil then
848 raise EZDatabaseError.Create(SConnectionIsNotAssigned);
853 Checks is the database has bidirectional access.
855 procedure TZAbstractRODataset.CheckBiDirectional;
857 if IsUniDirectional then
858 raise EZDatabaseError.Create(SOperationIsNotAllowed1);
862 Checks the correct SQL query.
864 procedure TZAbstractRODataset.CheckSQLQuery;
866 if FSQL.StatementCount < 1 then
867 raise EZDatabaseError.Create(SQueryIsEmpty);
868 if FSQL.StatementCount > 1 then
869 raise EZDatabaseError.Create(SCanNotExecuteMoreQueries);
873 Raises an error 'Operation is not allowed in read-only dataset.
875 procedure TZAbstractRODataset.RaiseReadOnlyError;
877 raise EZDatabaseError.Create(SOperationIsNotAllowed2);
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.
885 function TZAbstractRODataset.FetchRows(RowCount: Integer): Boolean;
887 Connection.ShowSQLHourGlass;
891 while FetchOneRow do;
896 while (CurrentRows.Count < RowCount) do
898 if not FetchOneRow then
901 Result := CurrentRows.Count >= RowCount;
904 Connection.HideSQLHourGlass;
909 Fetches one row from the result set.
910 @return <code>True</code> if record was successfully fetched.
912 function TZAbstractRODataset.FetchOneRow: Boolean;
914 if Assigned(ResultSet) then
916 if (FetchCount = 0) or (ResultSet.GetRow = FetchCount)
917 or ResultSet.MoveAbsolute(FetchCount) then
918 Result := ResultSet.Next
924 if FilterRow(ResultSet.GetRow) then
925 CurrentRows.Add(Pointer(ResultSet.GetRow))
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.
939 function TZAbstractRODataset.FilterRow(RowNo: Integer): Boolean;
943 SavedRows: TZSortedList;
944 SavedState: TDatasetState;
948 { Locates the result set to the specified row. }
949 if ResultSet.GetRow <> RowNo then
951 if not ResultSet.MoveAbsolute(RowNo) then
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
965 Result := usUnmodified in ShowRecordTypes;
969 { Check master-detail links }
970 if MasterLink.Active then
972 for I := 0 to MasterLink.Fields.Count - 1 do
974 if I < IndexFields.Count then
975 Result := CompareKeyFields(TField(IndexFields[I]), ResultSet,
976 TField(MasterLink.Fields[I]));
985 { Checks record by OnFilterRecord event }
986 if FilterEnabled and Assigned(OnFilterRecord) then
988 SavedRow := CurrentRow;
989 SavedRows := CurrentRows;
990 CurrentRows := TZSortedList.Create;
992 SavedState := SetTempState(dsNewValue);
993 CurrentRows.Add(Pointer(RowNo));
997 OnFilterRecord(Self, Result);
999 if Assigned(ApplicationHandleException)
1000 then ApplicationHandleException(Self);
1003 CurrentRow := SavedRow;
1005 CurrentRows := SavedRows;
1006 RestoreState(SavedState);
1012 { Check the record by filter expression. }
1013 if FilterEnabled and (FilterExpression.Expression <> '') then
1015 if not InitFilterFields then
1017 FilterFieldRefs := DefineFilterFields(Self, FilterExpression);
1018 InitFilterFields := True;
1020 CopyDataFieldsToVars(FilterFieldRefs, ResultSet,
1021 FilterExpression.DefaultVariables);
1022 Result := FilterExpression.VariantManager.GetAsBoolean(
1023 FilterExpression.Evaluate4(FilterExpression.DefaultVariables,
1024 FilterExpression.DefaultFunctions, FilterStack));
1031 Go to specified row.
1032 @param RowNo a number of the row.
1033 @return <code>True</code> if the row successfully located.
1035 function TZAbstractRODataset.GotoRow(RowNo: Integer): Boolean;
1040 Index := CurrentRows.IndexOf(Pointer(RowNo));
1043 if Index < CurrentRow then
1045 CurrentRow := Index + 1;
1051 Rereads all rows and applies a filter.
1053 procedure TZAbstractRODataset.RereadRows;
1057 if not (State in [dsInactive]) and not IsUniDirectional then
1059 if (CurrentRow > 0) and (CurrentRow <= CurrentRows.Count) and
1060 (CurrentRows.Count > 0) then
1061 RowNo := Integer(CurrentRows[CurrentRow - 1])
1066 for I := 1 to FetchCount do
1068 if FilterRow(I) then
1069 CurrentRows.Add(Pointer(I));
1072 CurrentRow := CurrentRows.IndexOf(Pointer(RowNo)) + 1;
1073 CurrentRow := Min(Max(1, CurrentRow), CurrentRows.Count);
1075 if FSortedFields <> '' then
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.
1089 procedure TZAbstractRODataset.SetStatementParams(Statement: IZPreparedStatement;
1090 ParamNames: TStringDynArray; Params: TParams; DataLink: TDataLink);
1093 TempParam, Param: TParam;
1097 if DataLink.Active then
1098 Dataset := DataLink.DataSet
1102 TempParam := TParam.Create(nil);
1105 for I := Low(ParamNames) to High(ParamNames) do
1107 if Assigned(Dataset) then
1108 Field := Dataset.FindField(ParamNames[I])
1112 if Assigned(Field) then
1114 TempParam.AssignField(Field);
1119 Param := Params.FindParam(ParamNames[I]);
1120 if not Assigned(Param) or (Param.ParamType in [ptOutput, ptResult]) then
1124 SetStatementParam(I+ 1, Statement, Param);
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.
1139 {$IFDEF WITH_TRECORDBUFFER}
1140 function TZAbstractRODataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
1141 DoCheck: Boolean): TGetResult;
1144 function TZAbstractRODataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
1145 DoCheck: Boolean): TGetResult;
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]);
1161 if FetchRows(CurrentRow + 1) then
1162 CurrentRow := CurrentRow + 1
1169 if (CurrentRow > 1) and (CurrentRows.Count > 0) then
1170 CurrentRow := CurrentRow - 1
1176 if CurrentRow < CurrentRows.Count then
1179 if CurrentRow = 0 then
1181 if CurrentRows.Count = 0 then
1183 CurrentRow := Min(CurrentRows.Count, 1);
1185 else if not FetchRows(CurrentRow) then
1186 CurrentRow := Max(1, Min(CurrentRows.Count, CurrentRow));
1188 if CurrentRows.Count = 0 then
1193 if Result = grOK then
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));
1205 if (Result = grError) and DoCheck then
1206 raise EZDatabaseError.Create(SNoMoreRecords);
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.
1214 function TZAbstractRODataset.GetActiveBuffer(var RowBuffer: PZRowBuffer):
1218 CachedResultSet: IZCachedResultSet;
1222 dsBrowse,dsblockread:
1224 RowBuffer := PZRowBuffer(ActiveBuffer);
1226 RowBuffer := PZRowBuffer(ActiveBuffer);
1228 RowBuffer := PZRowBuffer(CalcBuffer);
1229 dsOldValue, dsNewValue, dsCurValue:
1231 RowNo := Integer(CurrentRows[CurrentRow - 1]);
1232 if RowNo <> ResultSet.GetRow then
1235 if State = dsOldValue then
1236 RowBuffer := OldRowBuffer
1238 RowBuffer := NewRowBuffer;
1240 if RowBuffer.Index <> RowNo then
1242 RowAccessor.RowBuffer := RowBuffer;
1244 if (ResultSet.GetRow = RowNo) or ResultSet.MoveAbsolute(RowNo) then
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;
1258 Result := RowBuffer <> nil;
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;
1266 if Field.DataType in [ftWideString] then
1267 NativeFormat := True;
1268 Result := inherited GetFieldData(Field, Buffer, NativeFormat);
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.
1277 function TZAbstractRODataset.GetFieldData(Field: TField;
1278 {$IFDEF WITH_VAR_TVALUEBUFFER}var{$ENDIF}Buffer:
1279 {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF}): Boolean;
1281 ColumnIndex: Integer;
1282 RowBuffer: PZRowBuffer;
1285 {$IFNDEF WITH_WIDESTRUTILS}
1289 if GetActiveBuffer(RowBuffer) then
1291 ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
1292 RowAccessor.RowBuffer := RowBuffer;
1293 if Buffer <> nil then
1295 case Field.DataType of
1296 { Processes DateTime fields. }
1297 ftDate, ftTime, ftDateTime:
1299 if Field.DataType <> ftTime then
1300 DateTimeToNative(Field.DataType,
1301 RowAccessor.GetTimestamp(ColumnIndex, Result), Buffer)
1303 DateTimeToNative(Field.DataType,
1304 RowAccessor.GetTime(ColumnIndex, Result), Buffer);
1305 Result := not Result;
1307 { Processes binary array fields. }
1310 Bts := RowAccessor.GetBytes(ColumnIndex, Result);
1311 System.Move(PAnsiChar(Bts)^,
1312 PAnsiChar(Buffer)^, Min(Length(Bts), RowAccessor.GetColumnDataSize(ColumnIndex)));
1313 Result := not Result;
1315 { Processes blob fields. }
1316 ftBlob, ftMemo, ftGraphic, ftFmtMemo {$IFDEF WITH_WIDEMEMO},ftWideMemo{$ENDIF} :
1317 Result := not RowAccessor.GetBlob(ColumnIndex, Result).IsEmpty;
1320 {$IFDEF WITH_WIDESTRUTILS}
1321 WStrCopy(PWideChar(Buffer), PWideChar(RowAccessor.GetUnicodeString(ColumnIndex, Result)));
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));
1328 Result := not Result;
1330 ftString{$IFDEF WITH_FTGUID}, ftGUID{$ENDIF}:
1332 {$IFDEF WITH_STRCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrCopy(PAnsiChar(Buffer), PAnsiChar({$IFDEF UNICODE}AnsiString{$ENDIF}(RowAccessor.GetString(ColumnIndex, Result))));
1333 Result := not Result;
1335 {$IFDEF WITH_FTDATASETSUPPORT}
1337 Result := not RowAccessor.GetDataSet(ColumnIndex, Result).IsEmpty;
1339 { Processes all other fields. }
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;
1349 System.Move(RowAccessor.GetColumnData(ColumnIndex, Result)^,
1350 Pointer(Buffer)^, RowAccessor.GetColumnDataSize(ColumnIndex));
1351 Result := not Result;
1357 if Field.DataType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo {$IFDEF WITH_WIDEMEMO},ftWideMemo{$ENDIF}] then
1358 Result := not RowAccessor.GetBlob(ColumnIndex, Result).IsEmpty
1360 Result := not RowAccessor.IsNull(ColumnIndex);
1368 Support for widestring field
1370 procedure TZAbstractRODataset.SetFieldData(Field: TField; Buffer: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF};
1371 NativeFormat: Boolean);
1373 if Field.DataType in [ftWideString{$IFDEF WITH_WIDEMEMO}, ftWideMemo{$ENDIF}] then
1374 NativeFormat := True;
1376 {$IFNDEF VIRTUALSETFIELDDATA}
1379 SetFieldData(Field, Buffer);
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.
1388 procedure TZAbstractRODataset.SetFieldData(Field: TField; Buffer: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF});
1390 ColumnIndex: Integer;
1391 RowBuffer: PZRowBuffer;
1400 raise EZDatabaseError.Create(SOperationIsNotAllowed4);
1401 if not RequestLive and (Field.FieldKind = fkData) then
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);
1412 if GetActiveBuffer(RowBuffer) then
1414 ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
1415 RowAccessor.RowBuffer := RowBuffer;
1417 if State in [dsEdit, dsInsert] then
1418 Field.Validate(Buffer);
1420 if Assigned(Buffer) then
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));
1433 RowAccessor.SetUnicodeString(ColumnIndex, PWideString(Buffer)^);
1435 ftString{$IFDEF WITH_FTGUID}, ftGUID{$ENDIF}: { Processes string fields. }
1437 RowAccessor.SetString(ColumnIndex, String(PAnsichar(Buffer)));
1440 L := {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(PAnsiChar(Buffer));
1442 Move(PAnsiChar(Buffer)^, PAnsiChar(Temp)^, L);
1443 RowAccessor.SetString(ColumnIndex, Temp);
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. }
1451 System.Move(Pointer(Buffer)^, RowAccessor.GetColumnData(ColumnIndex, WasNull)^,
1452 RowAccessor.GetColumnDataSize(ColumnIndex));
1453 RowAccessor.SetNotNull(ColumnIndex);
1458 RowAccessor.SetNull(ColumnIndex);
1460 if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
1461 DataEvent(deFieldChange, ULong(Field));
1464 raise EZDatabaseError.Create(SRowDataIsNotAvailable);
1466 if Field.FieldKind = fkData then
1468 OldRowBuffer.Index := -1;
1469 NewRowBuffer.Index := -1;
1474 Checks is the cursor opened.
1475 @return <code>True</code> if the cursor is opened.
1477 function TZAbstractRODataset.IsCursorOpen: Boolean;
1479 Result := ResultSet <> nil;
1483 Gets an affected rows by the last executed statement.
1484 @return a number of last updated rows.
1486 function TZAbstractRODataset.RowsAffected: LongInt;
1488 Result := FRowsAffected;
1492 Gets the size of the record buffer.
1493 @return the size of the record buffer.
1495 function TZAbstractRODataset.GetRecordSize: Word;
1497 Result := RowAccessor.RowSize;
1501 Allocates a buffer for new record.
1502 @return an allocated record buffer.
1505 {$IFDEF WITH_TRECORDBUFFER}
1507 function TZAbstractRODataset.AllocRecordBuffer: TRecordBuffer;
1509 Result := TRecordBuffer(RowAccessor.Alloc);
1513 function TZAbstractRODataset.AllocRecordBuffer: PChar;
1515 Result := PChar(RowAccessor.Alloc);
1520 Frees a previously allocated record buffer.
1521 @param Buffer a previously allocated buffer.
1524 {$IFDEF WITH_TRECORDBUFFER}
1526 procedure TZAbstractRODataset.FreeRecordBuffer(var Buffer: TRecordBuffer);
1529 procedure TZAbstractRODataset.FreeRecordBuffer(var Buffer: PChar);
1532 RowAccessor.DisposeBuffer(PZRowBuffer(Buffer));
1536 Fetch all records. Added by Patyi
1538 procedure TZAbstractRODataset.FetchAll;
1540 Connection.ShowSQLHourGlass;
1544 Connection.HideSQLHourGlass;
1548 Executes a DML SQL statement.
1550 procedure TZAbstractRODataset.ExecSQL;
1554 Connection.ShowSQLHourGlass;
1558 Connection.HideSQLHourGlass;
1564 Connection.ShowSQLHourGlass;
1566 SetStatementParams(Statement, FSQL.Statements[0].ParamNamesArray,
1567 FParams, FDataLink);
1569 FRowsAffected := Statement.ExecuteUpdatePrepared;
1571 Connection.HideSQLHourGlass;
1576 Performs an internal initialization of field defiitions.
1578 procedure TZAbstractRODataset.InternalInitFieldDefs;
1580 I, J, Size: Integer;
1582 FieldType: TFieldType;
1583 ResultSet: IZResultSet;
1588 ResultSet := Self.ResultSet;
1589 AutoInit := ResultSet = nil;
1592 { Opens an internal result set if query is closed. }
1598 ResultSet := CreateResultSet(FSQL.Statements[0].SQL, 0);
1600 if not Assigned(ResultSet) then
1601 raise Exception.Create(SCanNotOpenResultSet);
1603 { Reads metadata from resultset. }
1605 with ResultSet.GetMetadata do
1607 if GetColumnCount > 0 then
1608 for I := 1 to GetColumnCount do
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)
1616 {$IFDEF WITH_FTGUID}
1617 if FieldType = ftGUID then
1624 FieldName := GetColumnLabel(I);
1626 while FieldDefs.IndexOf(FName) >= 0 do
1629 FName := Format('%s_%d', [FieldName, J]);
1632 with TFieldDef.Create(FieldDefs, FName, FieldType,
1636 Required := IsWritable(I) and (IsNullable(I) = ntNoNulls);
1638 if IsReadOnly(I) then Attributes := Attributes + [faReadonly];
1639 Precision := GetPrecision(I);
1640 DisplayName := FName;
1646 { Closes localy opened resultset. }
1649 if ResultSet <> nil then
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.
1665 function TZAbstractRODataset.CreateStatement(const SQL: string; Properties: TStrings):
1666 IZPreparedStatement;
1670 Temp := TStringList.Create;
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'
1678 Temp.Values['defaults'] := 'false';
1679 if doPreferPrepared in FOptions then
1680 Temp.Values['preferprepared'] := 'true'
1682 Temp.Values['preferprepared'] := 'false';
1684 Result := FConnection.DbcConnection.PrepareStatementWithParams(SQL, Temp);
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.
1696 function TZAbstractRODataset.CreateResultSet(const SQL: string;
1697 MaxRows: Integer): IZResultSet;
1699 Connection.ShowSQLHourGlass;
1701 SetStatementParams(Statement, FSQL.Statements[0].ParamNamesArray,
1702 FParams, FDataLink);
1704 Statement.SetResultSetConcurrency(rcUpdatable)
1706 Statement.SetResultSetConcurrency(rcReadOnly);
1707 Statement.SetFetchDirection(fdForward);
1708 if IsUniDirectional then
1709 Statement.SetResultSetType(rtForwardOnly)
1711 Statement.SetResultSetType(rtScrollInsensitive);
1713 Statement.SetMaxRows(MaxRows);
1715 if doSmartOpen in FOptions then
1717 if Statement.ExecutePrepared then
1718 Result := Statement.GetResultSet
1723 Result := Statement.ExecuteQueryPrepared;
1725 Connection.HideSQLHourGlass;
1730 Performs internal query opening.
1732 procedure TZAbstractRODataset.InternalOpen;
1734 ColumnList: TObjectList;
1738 If (csDestroying in Componentstate) then
1739 raise Exception.Create(SCanNotOpenDataSetWhenDestroying);
1741 if not FUseCurrentStatment then Prepare;
1747 Connection.ShowSQLHourGlass;
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)
1754 ResultSet := CreateResultSet('', -1);
1755 if not Assigned(ResultSet) then
1757 if not (doSmartOpen in FOptions) then
1758 raise Exception.Create(SCanNotOpenResultSet)
1763 { Initializes field and index defs. }
1764 if not FRefreshInProgress then
1765 InternalInitFieldDefs;
1767 if DefaultFields and not FRefreshInProgress then
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
1777 if not (ResultSet.GetMetadata.GetColumnDisplaySize(I+1) = 0) then
1779 {$IFNDEF FPC}Fields[i].Size := ResultSet.GetMetadata.GetColumnDisplaySize(I+1);{$ENDIF}
1780 Fields[i].DisplayWidth := ResultSet.GetMetadata.GetColumnDisplaySize(I+1);
1785 { Initializes accessors and buffers. }
1786 ColumnList := ConvertFieldsToColumnInfo(Fields);
1788 RowAccessor := TZRowAccessor.Create(ColumnList, Connection.DbcConnection.GetConSettings);
1792 FOldRowBuffer := PZRowBuffer(AllocRecordBuffer);
1793 FNewRowBuffer := PZRowBuffer(AllocRecordBuffer);
1795 FieldsLookupTable := CreateFieldsLookupTable(Fields);
1796 InitFilterFields := False;
1799 GetFieldList(IndexFields, FLinkedFields); {renamed by bangfauzan}
1801 { Performs sorting. }
1802 if FSortedFields <> '' then
1805 Connection.HideSQLHourGlass;
1810 Performs internal query closing.
1812 procedure TZAbstractRODataset.InternalClose;
1814 if ResultSet <> nil then
1815 if not FDoNotCloseResultSet then ResultSet.Close;
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.
1822 FreeRecordBuffer(PChar(FOldRowBuffer));
1824 FOldRowBuffer := nil;
1825 if FNewRowBuffer <> nil then
1826 {$IFDEF WITH_TRECORDBUFFER}
1827 FreeRecordBuffer(TRecordBuffer(FNewRowBuffer));
1829 FreeRecordBuffer(PChar(FNewRowBuffer));
1831 FNewRowBuffer := nil;
1833 if RowAccessor <> nil then
1837 { Destroy default fields }
1838 if DefaultFields and not FRefreshInProgress then
1842 FieldsLookupTable := nil;
1846 Performs internal go to first record.
1848 procedure TZAbstractRODataset.InternalFirst;
1850 if CurrentRow > 0 then
1856 Performs internal go to last record.
1858 procedure TZAbstractRODataset.InternalLast;
1861 if CurrentRows.Count > 0 then
1862 CurrentRow := CurrentRows.Count + 1
1868 Processes internal exception handling.
1870 procedure TZAbstractRODataset.InternalHandleException;
1872 // Application.HandleException(Self);
1876 Gets the maximum records count.
1877 @return the maximum records count.
1879 function TZAbstractRODataset.GetRecordCount: LongInt;
1882 if not IsUniDirectional then
1883 FetchRows(FFetchRow); // the orginal code was FetchRows(0); modifyed by Patyi
1884 Result := CurrentRows.Count;
1888 Gets the current record number.
1889 @return the current record number.
1891 function TZAbstractRODataset.GetRecNo: Longint;
1895 Result := CurrentRow;
1899 Moves current record to the specified record.
1900 @param Value a new current record number.
1902 procedure TZAbstractRODataset.MoveRecNo(Value: Integer);
1904 PreviousCurrentRow: Integer;
1906 Value := Max(1, Value);
1907 if Value < CurrentRow then
1910 if FetchRows(Value) then
1913 CurrentRow := CurrentRows.Count;
1915 PreviousCurrentRow := CurrentRow;//Resync moves the current row away
1917 if not (State in [dsInactive]) then
1920 CurrentRow := PreviousCurrentRow;
1926 Sets a new currenct record number.
1927 @param Value a new current record number.
1929 procedure TZAbstractRODataset.SetRecNo(Value: Integer);
1932 Value := Max(1, Value);
1933 if Value < CurrentRow then
1942 Defines is the query editable?
1943 @return <code>True</code> if the query is editable.
1945 function TZAbstractRODataset.GetCanModify: Boolean;
1947 Result := RequestLive;
1951 Gets a linked datasource.
1952 @returns a linked datasource.
1954 function TZAbstractRODataset.GetDataSource: TDataSource;
1956 Result := DataLink.DataSource;
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.
1964 procedure TZAbstractRODataset.SetPrepared(Value: Boolean);
1966 FUseCurrentStatment := False;
1967 FDoNotCloseResultSet := False;
1968 If Value <> FPrepared then
1979 Sets a new linked datasource.
1980 @param Value a new linked datasource.
1982 procedure TZAbstractRODataset.SetDataSource(Value: TDataSource);
1985 if IsLinkedTo(Value) then
1987 if Value.IsLinkedTo(Self) then
1989 raise EZDatabaseError.Create(SCircularLink);
1990 DataLink.DataSource := Value;
1994 Gets a master datasource.
1995 @returns a master datasource.
1997 function TZAbstractRODataset.GetMasterDataSource: TDataSource;
1999 Result := MasterLink.DataSource;
2003 Sets a new master datasource.
2004 @param Value a new master datasource.
2006 procedure TZAbstractRODataset.SetMasterDataSource(Value: TDataSource);
2009 if IsLinkedTo(Value) then
2011 if Value.IsLinkedTo(Self) then
2013 raise EZDatabaseError.Create(SCircularLink);
2014 MasterLink.DataSource := Value;
2019 Gets master link fields.
2020 @returns a list with master fields.
2022 function TZAbstractRODataset.GetMasterFields: string;
2024 Result := FMasterLink.FieldNames;
2028 Sets master link fields.
2029 @param Value a new master link fields.
2031 procedure TZAbstractRODataset.SetMasterFields(const Value: string);
2033 if FMasterLink.FieldNames <> Value then
2035 FMasterLink.FieldNames := Value;
2041 Processes change events from the master dataset.
2042 @param Sender an event sender object.
2044 procedure TZAbstractRODataset.MasterChanged(Sender: TObject);
2047 if (doAlwaysDetailResync in FOptions) or (FMasterLink.DataSet = nil)
2048 or not (FMasterLink.DataSet.State in [dsEdit, dsInsert]) then
2053 Processes disable events from the master dataset.
2054 @param Sender an event sender object.
2056 procedure TZAbstractRODataset.MasterDisabled(Sender: TObject);
2062 Initializes new record with master fields.
2065 procedure TZAbstractRODataset.DoOnNewRecord;
2068 MasterField, DetailField: TField;
2072 if MasterLink.Active and (MasterLink.Fields.Count > 0) then
2074 for I := 0 to MasterLink.Fields.Count - 1 do
2076 if I < IndexFields.Count then
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
2084 if MasterField is TLargeIntField then
2085 Temp := TLargeIntField(
2086 MasterField).{$IFDEF WITH_ASLARGEINT}AsLargeInt{$ELSE}Value{$ENDIF}
2088 Temp := MasterField.AsInteger;
2089 if DetailField is TLargeIntField then
2090 TLargeIntField(DetailField).{$IFDEF WITH_ASLARGEINT}AsLargeInt{$ELSE}Value{$ENDIF} := Temp
2092 DetailField.AsString := IntToStr(Temp);
2094 // Processes all other fields.
2096 DetailField.Value := MasterField.Value;
2102 if DataLink.Active and (DataLink.dataset.Fields.Count > 0) then
2105 while (P1 <= Length(LinkedFields)) and (p2 <= Length(MasterFields)) do
2107 DetailField := FieldByName(ExtractFieldName(LinkedFields, P1));
2108 MasterField := DataLink.DataSet.FieldByName (ExtractFieldName(MasterFields, P2));
2109 DetailField.Assign(MasterField);
2113 inherited DoOnNewRecord;
2118 Gets a list of index field names.
2119 @returns a list of index field names.
2121 function TZAbstractRODataset.GetLinkedFields: string; {renamed by bangfauzan}
2123 Result := FLinkedFields; {renamed by bangfauzan}
2127 Sets a new list of index field names.
2128 @param Value a new list of index field names.
2130 procedure TZAbstractRODataset.SetLinkedFields(const Value: string); {renamed by bangfauzan}
2132 if FLinkedFields <> Value then {renamed by bangfauzan}
2134 FLinkedFields := Value; {renamed by bangfauzan}
2136 if State <> dsInactive then
2138 GetFieldList(IndexFields, FLinkedFields); {renamed by bangfauzan}
2145 Sets a new set of dataset options.
2146 @param Value a new set of dataset options.
2148 procedure TZAbstractRODataset.SetOptions(Value: TZDatasetOptions);
2150 if FOptions <> Value then
2155 Sets a new sorted fields.
2156 @param Value a new sorted fields.
2158 procedure TZAbstractRODataset.SetSortedFields({const} Value: string); {bangfauzan modification}
2160 Value:=Trim(Value); {bangfauzan addition}
2161 if (FSortedFields <> Value) or (FIndexFieldNames <> Value)then {bangfauzan modification}
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]);
2171 FSortedFields := Value;
2174 {bangfauzan modification}
2175 if (FSortedFields = '') then
2176 Self.InternalRefresh
2179 {end of bangfauzan modification}
2184 Refreshes parameters and reopens the dataset.
2186 procedure TZAbstractRODataset.RefreshParams;
2192 if FDataLink.DataSource <> nil then
2194 DataSet := FDataLink.DataSource.DataSet;
2195 if DataSet <> nil then
2196 if DataSet.Active and not (DataSet.State in [dsSetKey, dsEdit]) then
2207 Performs the internal preparation of the query.
2209 procedure TZAbstractRODataset.InternalPrepare;
2212 CheckInactive; //AVZ - Need to check this
2215 Connection.ShowSQLHourGlass;
2217 if (FSQL.StatementCount > 0) and((Statement = nil) or (Statement.GetConnection.IsClosed)) then
2218 Statement := CreateStatement(FSQL.Statements[0].SQL, Properties)
2220 if (Assigned(Statement)) then
2221 Statement.ClearParameters;
2223 Connection.HideSQLHourGlass;
2228 Rolls back the internal preparation of the query.
2230 procedure TZAbstractRODataset.InternalUnPrepare;
2232 if Statement <> nil then
2240 Performs internal switch to the specified bookmark.
2241 @param Bookmark a specified bookmark.
2243 procedure TZAbstractRODataset.InternalGotoBookmark(Bookmark: Pointer);
2245 if not GotoRow(PInteger(Bookmark)^) then
2246 raise EZDatabaseError.Create(SBookmarkWasNotFound);
2250 Performs an internal switch to the specified record.
2251 @param Buffer the specified row buffer.
2254 {$IFDEF WITH_TRECORDBUFFER}
2255 procedure TZAbstractRODataset.InternalSetToRecord(Buffer: TRecordBuffer);
2257 procedure TZAbstractRODataset.InternalSetToRecord(Buffer: PChar);
2260 GotoRow(PZRowBuffer(Buffer)^.Index);
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
2269 procedure TZAbstractRODataset.InternalAddRecord(Buffer: Pointer;
2276 Performs an internal record removing.
2278 procedure TZAbstractRODataset.InternalDelete;
2284 Performs an internal post updates.
2286 procedure TZAbstractRODataset.InternalPost;
2287 procedure Checkrequired;
2290 columnindex : integer;
2292 For I:=0 to Fields.Count-1 do
2296 if Required and not ReadOnly and (FieldKind=fkData) and IsNull then
2297 raise EZDatabaseError.Create(Format(SNeedField,[DisplayName]));
2299 if Required and not ReadOnly and (FieldKind=fkData) and IsNull then
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]));
2312 if not (Self is TZAbstractDataset) then
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.
2324 {$IFDEF WITH_TRECORDBUFFER}
2326 function TZAbstractRODataset.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
2329 function TZAbstractRODataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
2332 Result := TBookmarkFlag(PZRowBuffer(Buffer)^.BookmarkFlag);
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.
2341 {$IFDEF WITH_TRECORDBUFFER}
2342 procedure TZAbstractRODataset.SetBookmarkFlag(Buffer: TRecordBuffer;
2343 Value: TBookmarkFlag);
2345 procedure TZAbstractRODataset.SetBookmarkFlag(Buffer: PChar;
2346 Value: TBookmarkFlag);
2349 PZRowBuffer(Buffer)^.BookmarkFlag := Ord(Value);
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.
2358 procedure TZAbstractRODataset.GetBookmarkData(
2359 Buffer: {$IFDEF WITH_TRECORDBUFFER}TRecordBuffer{$ELSE}PChar{$ENDIF};
2360 Data: {$IFDEF WITH_BOOKMARKDATA_TBOOKMARK}TBookMark{$ELSE}Pointer{$ENDIF});
2362 PInteger(Data)^ := PZRowBuffer(Buffer)^.Index;
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.
2372 procedure TZAbstractRODataset.SetBookmarkData(
2373 Buffer: {$IFDEF WITH_TRECORDBUFFER}TRecordBuffer{$ELSE}PChar{$ENDIF};
2374 Data: {$IFDEF WITH_BOOKMARKDATA_TBOOKMARK}TBookMark{$ELSE}Pointer{$ENDIF});
2376 PZRowBuffer(Buffer)^.Index := PInteger(Data)^;
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.
2386 function TZAbstractRODataset.CompareBookmarks(Bookmark1,
2387 Bookmark2: TBookmark): Integer;
2389 Index1, Index2: Integer;
2392 if not Assigned(Bookmark1) or not Assigned(Bookmark2) then
2395 Index1 := CurrentRows.IndexOf(Pointer(PInteger(Bookmark1)^));
2396 Index2 := CurrentRows.IndexOf(Pointer(PInteger(Bookmark2)^));
2398 if Index1 < Index2 then Result := -1
2399 else if Index1 > Index2 then Result := 1;
2403 Checks is the specified bookmark valid.
2404 @param Bookmark a bookmark object.
2405 @return <code>True</code> if the bookmark is valid.
2407 function TZAbstractRODataset.BookmarkValid(Bookmark: TBookmark): Boolean;
2410 if Active and Assigned(Bookmark) and (FResultSet <> nil) then
2412 Result := CurrentRows.IndexOf(Pointer(PInteger(Bookmark)^)) >= 0;
2419 Performs an internal initialization of record buffer.
2420 @param Buffer a record buffer for initialization.
2423 {$IFDEF WITH_TRECORDBUFFER}
2424 procedure TZAbstractRODataset.InternalInitRecord(Buffer: TRecordBuffer);
2426 procedure TZAbstractRODataset.InternalInitRecord(Buffer: PChar);
2429 RowAccessor.ClearBuffer(PZRowBuffer(Buffer));
2433 Performs an internal refreshing.
2435 procedure TZAbstractRODataset.InternalRefresh;
2440 Temp: TZVariantDynArray;
2442 FieldRefs: TObjectDynArray;
2443 OnlyDataFields: Boolean;
2445 OnlyDataFields := False;
2449 if CurrentRow > 0 then
2451 RowNo := Integer(CurrentRows[CurrentRow - 1]);
2452 if ResultSet.GetRow <> RowNo then
2453 ResultSet.MoveAbsolute(RowNo);
2455 if Properties.Values['KeyFields'] <> '' then
2456 KeyFields := Properties.Values['KeyFields']
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])
2465 KeyValues := EncodeVariantArray(Temp);
2470 KeyValues := Unassigned;
2476 FRefreshInProgress := True;
2480 FRefreshInProgress := False;
2484 if KeyFields <> '' then
2485 Found := Locate(KeyFields, KeyValues, [])
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.
2506 function TZAbstractRODataset.FindRecord(Restart, GoForward: Boolean): Boolean;
2509 SavedFilterEnabled: Boolean;
2511 { Checks the current state. }
2516 { Defines an initial position position. }
2524 Index := CurrentRows.Count;
2529 Index := CurrentRow;
2533 if Index > CurrentRows.Count then
2541 SavedFilterEnabled := FilterEnabled;
2543 FilterEnabled := True;
2544 while (Index >= 1) and (Index <= CurrentRows.Count) do
2546 if FilterRow(Index) then
2554 if Index > CurrentRows.Count then
2561 FilterEnabled := SavedFilterEnabled;
2564 { Sets a new found position. }
2574 Sets a filtering control flag.
2575 @param Value <code>True</code> to turn filtering On.
2577 procedure TZAbstractRODataset.SetFiltered(Value: Boolean);
2579 if Value <> FilterEnabled then
2581 FilterEnabled := Value;
2582 inherited SetFiltered(Value);
2588 Sets a new filter expression string.
2589 @param Value a new filter expression.
2591 procedure TZAbstractRODataset.SetFilterText(const Value: string);
2593 inherited SetFilterText(Value);
2594 FilterExpression.DefaultVariables.Clear;
2595 FilterExpression.Expression := Value;
2596 InitFilterFields := False;
2597 if FilterEnabled then
2602 Checks is the opened resultset sequensed?
2603 @return <code>True</code> if the opened resultset is sequenced.
2605 function TZAbstractRODataset.IsSequenced: Boolean;
2607 Result := (not FilterEnabled);
2611 Processes component notifications.
2612 @param AComponent a changed component object.
2613 @param Operation a component operation code.
2615 procedure TZAbstractRODataset.Notification(AComponent: TComponent;
2616 Operation: TOperation);
2618 inherited Notification(AComponent, Operation);
2620 if (Operation = opRemove) and (AComponent = FConnection) then
2626 if (Operation = opRemove) and Assigned(FDataLink)
2627 and (AComponent = FDataLink.Datasource) then
2628 FDataLink.DataSource := nil;
2630 if (Operation = opRemove) and Assigned(FMasterLink)
2631 and (AComponent = FMasterLink.Datasource) then
2633 FMasterLink.DataSource := nil;
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.
2645 function TZAbstractRODataset.InternalLocate(const KeyFields: string;
2646 const KeyValues: Variant; Options: TLocateOptions): LongInt;
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;
2658 OnlyDataFields := False;
2661 DecodedKeyValues := nil;
2663 PartialKey := loPartialKey in Options;
2664 CaseInsensitive := loCaseInsensitive in Options;
2666 FieldRefs := DefineFields(Self, KeyFields, OnlyDataFields);
2667 FieldIndices := nil;
2668 if FieldRefs = nil then
2670 DecodedKeyValues := DecodeVariantArray(KeyValues);
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));
2677 if not OnlyDataFields then
2679 { Processes fields if come calculated or lookup fields are involved. }
2680 SearchRowBuffer := PZRowBuffer(AllocRecordBuffer);
2683 FieldIndices := DefineFieldIndices(FieldsLookupTable, FieldRefs);
2684 RowCount := CurrentRows.Count;
2687 while (I >= RowCount) and FetchOneRow do
2688 RowCount := CurrentRows.Count;
2689 if I >= RowCount then
2692 RowNo := Integer(CurrentRows[I]);
2693 ResultSet.MoveAbsolute(RowNo);
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));
2701 GetCalcFields(PChar(SearchRowBuffer));
2703 RetrieveDataFieldsFromRowAccessor(
2704 FieldRefs, FieldIndices, RowAccessor, RowValues);
2706 if CompareDataFields(DecodedKeyValues, RowValues,
2707 PartialKey, CaseInsensitive) then
2716 if SearchRowBuffer <> nil then
2717 {$IFDEF WITH_TRECORDBUFFER}
2718 FreeRecordBuffer(TRecordBuffer(SearchRowBuffer));
2720 FreeRecordBuffer(PChar(SearchRowBuffer));
2726 PrepareValuesForComparison(FieldRefs, DecodedKeyValues,
2727 ResultSet, PartialKey, CaseInsensitive);
2729 { Processes only data fields. }
2731 RowCount := CurrentRows.Count;
2734 while (I >= RowCount) and FetchOneRow do
2735 RowCount := CurrentRows.Count;
2736 if I >= RowCount then
2739 RowNo := Integer(CurrentRows[I]);
2740 ResultSet.MoveAbsolute(RowNo);
2742 if CompareFieldsFromResultSet(FieldRefs, DecodedKeyValues,
2743 ResultSet, PartialKey, CaseInsensitive) then
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.
2761 function TZAbstractRODataset.Locate(const KeyFields: string;
2762 const KeyValues: Variant; Options: TLocateOptions): Boolean;
2767 if (Active) then //AVZ Check if the dataset is active before performing locate - return false otherwise
2769 Index := InternalLocate(KeyFields, KeyValues, Options);
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.
2794 function TZAbstractRODataset.Lookup(const KeyFields: string;
2795 const KeyValues: Variant; const ResultFields: string): Variant;
2798 FieldRefs: TObjectDynArray;
2799 FieldIndices: TIntegerDynArray;
2800 OnlyDataFields: Boolean;
2801 SearchRowBuffer: PZRowBuffer;
2802 ResultValues: TZVariantDynArray;
2804 OnlyDataFields := False;
2806 RowNo := InternalLocate(KeyFields, KeyValues, []);
2808 FieldIndices := nil;
2812 { Fill result array }
2813 FieldRefs := DefineFields(Self, ResultFields, OnlyDataFields);
2814 FieldIndices := DefineFieldIndices(FieldsLookupTable, FieldRefs);
2815 SetLength(ResultValues, Length(FieldRefs));
2816 SearchRowBuffer := PZRowBuffer(AllocRecordBuffer);
2818 RowNo := Integer(CurrentRows[RowNo - 1]);
2819 if ResultSet.GetRow <> RowNo then
2820 ResultSet.MoveAbsolute(RowNo);
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));
2828 GetCalcFields(PChar(SearchRowBuffer));
2830 RetrieveDataFieldsFromRowAccessor(
2831 FieldRefs, FieldIndices, RowAccessor, ResultValues);
2833 {$IFDEF WITH_TRECORDBUFFER}
2834 FreeRecordBuffer(TRecordBuffer(SearchRowBuffer));
2836 FreeRecordBuffer(PChar(SearchRowBuffer));
2840 if Length(FieldIndices) = 1 then
2841 Result := EncodeVariant(ResultValues[0])
2843 Result := EncodeVariantArray(ResultValues);
2847 Gets the updated status for the current row.
2848 @return the UpdateStatus value for the current row.
2850 function TZAbstractRODataset.UpdateStatus: TUpdateStatus;
2854 Result := usUnmodified;
2855 if (ResultSet <> nil) and (CurrentRows.Count > 0) then
2857 RowNo := Integer(CurrentRows[CurrentRow - 1]);
2858 if ResultSet.GetRow <> RowNo then
2859 ResultSet.MoveAbsolute(RowNo);
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;
2871 Translates strings between ansi and oem character sets.
2873 function TZAbstractRODataset.Translate(Src, Dest: PAnsiChar; ToOem: Boolean):
2876 if (Src <> nil) then
2878 Result := {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(Src);
2880 if doOemTranslate in FOptions then
2883 CharToOemA(Src, Dest)
2885 OemToCharA(Src, Dest);
2891 if (Src <> Dest) then
2892 {$IFDEF WITH_STRCOPY_DEPRECATED}AnsiStrings.{$ENDIF}StrCopy(Dest, Src);
2901 If this actually does happen at the database connection level depends on the
2902 specific implementation.
2904 procedure TZAbstractRODataset.Prepare;
2910 Unprepares the query.
2911 Before the query gets executed it must be prepared again.
2913 procedure TZAbstractRODataset.Unprepare;
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.
2924 function TZAbstractRODataset.CreateBlobStream(Field: TField;
2925 Mode: TBlobStreamMode): TStream;
2927 ColumnIndex: Integer;
2928 RowBuffer: PZRowBuffer;
2936 if (Field.DataType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo {$IFDEF WITH_WIDEMEMO},ftWideMemo{$ENDIF}])
2937 and GetActiveBuffer(RowBuffer) then
2939 ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
2940 RowAccessor.RowBuffer := RowBuffer;
2942 if Mode = bmRead then
2944 case Field.DataType of
2946 Result := RowAccessor.GetAsciiStream(ColumnIndex, WasNull);
2947 {$IFDEF WITH_WIDEMEMO}
2949 Result := RowAccessor.GetUnicodeStream(ColumnIndex, WasNull)
2952 Result := RowAccessor.GetBinaryStream(ColumnIndex, WasNull);
2957 Blob := RowAccessor.GetBlob(ColumnIndex, WasNull);
2960 RowAccessor.SetBlob(ColumnIndex, Blob);
2961 Result := TZBlobStream.Create(Field as TBlobField, Blob, Mode,
2962 FConnection.DbcConnection.GetConSettings);
2965 if Result = nil then
2966 Result := TMemoryStream.Create;
2969 {$IFDEF WITH_FTDATASETSUPPORT}
2970 function TZAbstractRODataset.CreateNestedDataSet(DataSetField: TDataSetField): TDataSet;
2972 Result := inherited CreateNestedDataSet(DataSetField);
2977 Closes the specified BLOB field.
2978 @param a BLOB field object.
2980 procedure TZAbstractRODataset.CloseBlob(Field: TField);
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
2989 procedure TZAbstractRODataset.SetAnotherResultset(const Value: IZResultSet);
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
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
3012 Performs sorting of the internal rows.
3014 procedure TZAbstractRODataset.InternalSort;
3017 SavedRowBuffer: PZRowBuffer;
3019 if FIndexFieldNames = '' then exit; {bangfauzan addition}
3020 if (ResultSet <> nil) and not IsUniDirectional then
3022 FIndexFieldNames := Trim(FIndexFieldNames); {bangfauzan modification}
3023 DefineSortedFields(Self, {FSortedFields} FIndexFieldNames {bangfauzan modification},
3024 FSortedFieldRefs, FSortedFieldDirs, FSortedOnlyDataFields);
3026 if (CurrentRow <= CurrentRows.Count) and (CurrentRows.Count > 0)
3027 and (CurrentRow > 0) then
3028 RowNo := Integer(CurrentRows[CurrentRow - 1])
3032 { Restores the previous order. }
3033 if Length(FSortedFieldRefs) = 0 then
3035 CurrentRows.Sort(ClearSort);
3040 if FSortedOnlyDataFields then
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);
3051 SavedRowBuffer := RowAccessor.RowBuffer;
3052 { Sorts using generic highlevel approach. }
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
3061 FSortedFieldIndices[I] := DefineFieldIndex(FieldsLookupTable,
3062 TField(FSortedFieldRefs[I]));
3064 { Performs sorting. }
3065 CurrentRows.Sort(HighLevelSort);
3067 { Disposed buffers for sorting. }
3068 RowAccessor.DisposeBuffer(FSortRowBuffer1);
3069 RowAccessor.DisposeBuffer(FSortRowBuffer2);
3070 RowAccessor.RowBuffer := SavedRowBuffer;
3075 CurrentRow := CurrentRows.IndexOf(Pointer(RowNo)) + 1;
3076 CurrentRow := Min(Max(0, CurrentRow), CurrentRows.Count);
3077 if not (State in [dsInactive]) then
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 >0 if Item1 > Item2, <0 it Item1 < Item2 and 0
3087 if Item1 and Item2 are equal.
3089 function TZAbstractRODataset.ClearSort(Item1, Item2: Pointer): Integer;
3091 Result := Integer(Item1) - Integer(Item2);
3095 Sorting list using generic approach which is slow but may be used
3096 with calculated fields.
3098 @param Item1 a reference to the first row.
3099 @param Item2 a reference to the second row.
3100 @returns >0 if Item1 > Item2, <0 it Item1 < Item2 and 0
3101 if Item1 and Item2 are equal.
3103 function TZAbstractRODataset.HighLevelSort(Item1, Item2: Pointer): Integer;
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));
3117 GetCalcFields(PChar(FSortRowBuffer1));
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));
3130 GetCalcFields(PChar(FSortRowBuffer2));
3133 { Compare both records. }
3134 Result := RowAccessor.CompareBuffers(FSortRowBuffer1, FSortRowBuffer2,
3135 FSortedFieldIndices, FSortedFieldDirs);
3139 Sorting list using lowlevel approach which is fast but may not be used
3140 with calculated fields.
3142 @param Item1 a reference to the first row.
3143 @param Item2 a reference to the second row.
3144 @returns >0 if Item1 > Item2, <0 it Item1 < Item2 and 0
3145 if Item1 and Item2 are equal.
3147 function TZAbstractRODataset.LowLevelSort(Item1, Item2: Pointer): Integer;
3149 Result := ResultSet.CompareRows(Integer(Item1), Integer(Item2),
3150 FSortedFieldIndices, FSortedFieldDirs);
3154 Sets a new dataset properties.
3155 @param Value a dataset properties.
3157 procedure TZAbstractRODataset.SetProperties(const Value: TStrings);
3159 FProperties.Assign(Value);
3162 {$IFDEF WITH_IPROVIDER}
3165 Starts a new transaction.
3167 procedure TZAbstractRODataset.PSStartTransaction;
3169 if Assigned(FConnection) and not FConnection.AutoCommit then
3171 if not FConnection.Connected then
3172 FConnection.Connect;
3173 FConnection.StartTransaction;
3178 Completes previously started transaction.
3179 @param Commit a commit transaction flag.
3181 procedure TZAbstractRODataset.PSEndTransaction(Commit: Boolean);
3183 if Assigned(FConnection) and FConnection.Connected
3184 and not FConnection.AutoCommit then
3189 FConnection.Rollback;
3194 Checks if this query is in transaction mode.
3195 @returns <code>True</code> if query in transaction.
3197 function TZAbstractRODataset.PSInTransaction: Boolean;
3199 Result := Assigned(FConnection) and FConnection.Connected
3200 and (FConnection.TransactIsolationLevel <> tiNone)
3201 and not FConnection.AutoCommit;
3205 Returns a string quote character.
3206 @retuns a quote character.
3208 {$IFDEF WITH_IPROVIDERWIDE}
3209 function TZAbstractRODataset.PSGetQuoteCharW: WideString;
3211 function TZAbstractRODataset.PSGetQuoteChar: string;
3214 if Assigned(FConnection) then
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);
3227 Checks if dataset can execute any commands?
3228 @returns <code>True</code> if the query can execute any commands.
3230 function TZAbstractRODataset.PSIsSQLSupported: Boolean;
3236 Checks if dataset can execute SQL queries?
3237 @returns <code>True</code> if the query can execute SQL.
3239 function TZAbstractRODataset.PSIsSQLBased: Boolean;
3245 Resets this dataset.
3247 procedure TZAbstractRODataset.PSReset;
3258 Execute statement a SQL query.
3260 procedure TZAbstractRODataset.PSExecute;
3266 Gets query parameters.
3267 @returns parameters of this query.
3269 function TZAbstractRODataset.PSGetParams: TParams;
3275 Set new query parameters
3276 @param AParams new parameters to set into this query.
3278 procedure TZAbstractRODataset.PSSetParams(AParams: TParams);
3280 if AParams.Count > 0 then
3281 Params.Assign(AParams);
3285 Sets a command text for this query to execute.
3286 @param CommandText a command text for this query.
3289 {$IFDEF WITH_IPROVIDERWIDE}
3290 procedure TZAbstractRODataset.PSSetCommandText(const CommandText: string);
3292 SQL.Text := CommandText;
3295 procedure TZAbstractRODataset.PSSetCommandText(const CommandText: WideString);
3297 procedure TZAbstractRODataset.PSSetCommandText(const CommandText: string);
3300 SQL.Text := CommandText;
3304 Updates a record in the specified dataset.
3305 @param UpdateKind a type of the update.
3306 @param Delta a dataset with updates.
3308 function TZAbstractRODataset.PSUpdateRecord(UpdateKind: TUpdateKind;
3309 Delta: TDataSet): Boolean;
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.
3320 function TZAbstractRODataset.PSGetUpdateException(E: Exception;
3321 Prev: EUpdateError): EUpdateError;
3323 PrevErrorCode: Integer;
3325 if E is EZSQLException then
3327 if Assigned(Prev) then
3328 PrevErrorCode := Prev.ErrorCode
3332 Result := EUpdateError.Create(E.Message, '',
3333 EZSQLException(E).ErrorCode, PrevErrorCode, E);
3336 Result := EUpdateError.Create(E.Message, '', -1, -1, E);
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.
3344 {$IFDEF WITH_IPROVIDERWIDE}
3345 function TZAbstractRODataset.PSGetTableNameW: WideString;
3347 function TZAbstractRODataset.PSGetTableName: string;
3351 Tokenizer: IZTokenizer;
3352 StatementAnalyser: IZStatementAnalyser;
3353 SelectSchema: IZSelectSchema;
3356 if FConnection <> nil then
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;
3369 Defines a list of query primary key fields.
3370 @returns a semicolon delimited list of query key fields.
3373 {$IFDEF WITH_IPROVIDERWIDE}
3375 function TZAbstractRODataset.PSGetKeyFieldsW: WideString;
3377 Result := inherited PSGetKeyFieldsW;
3381 function TZAbstractRODataset.PSGetKeyFields: string;
3383 Result := inherited PSGetKeyFields;
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.
3395 {$IFDEF WITH_IPROVIDERWIDE}
3396 function TZAbstractRODataset.PSExecuteStatement(const ASQL: WideString; AParams: TParams;
3397 ResultSet: Pointer = nil): Integer;
3399 function TZAbstractRODataset.PSExecuteStatement(const ASQL: string;
3400 AParams: TParams; ResultSet: Pointer): Integer;
3404 Statement: IZPreparedStatement;
3407 if Assigned(FConnection) then
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
3415 ParamValue := AParams[I];
3416 SetStatementParam(I+1, Statement, ParamValue);
3418 Result := Statement.ExecuteUpdatePrepared;
3426 procedure TZAbstractRODataset.CheckFieldCompatibility(Field: TField;FieldDef: TFieldDef);
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
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}
3452 CheckTypeSizes = [ftBytes, ftVarBytes, ftBCD, ftReference];
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);
3466 Reset the calculated (includes fkLookup) fields
3470 {$IFDEF WITH_TRECORDBUFFER}
3472 procedure TZAbstractRODataset.ClearCalcFields(Buffer: TRecordBuffer);
3475 procedure TZAbstractRODataset.ClearCalcFields(Buffer: PChar);
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]));
3486 {=======================bangfauzan addition========================}
3487 function TZAbstractRODataset.GetSortType: TSortType;
3489 AscCount, DescCount: Integer;
3492 {pawelsel modification}
3495 s:=StringReplace(FIndexFieldNames,';',',',[rfReplaceAll]);
3496 while Pos(',',s)>0 do
3498 if Pos(' DESC',UpperCase(Copy(s,1,Pos(',',s))))>0 then
3502 s:=Copy(s,Pos(',',s)+1,Length(s)-Pos(',',s));
3505 if Pos(' DESC',UpperCase(s))>0 then
3509 if (DescCount > 0) and (AscCount > 0) then
3511 else if (DescCount > 0) then
3512 Result:=stDescending
3514 Result:=stAscending;
3517 procedure TZAbstractRODataset.SetSortType(Value: TSortType);
3519 if FSortType <> Value then
3522 if (FSortType <> stIgnored) then
3523 begin {pawelsel modification}
3524 FSortedFields:=StringReplace(FSortedFields,' Desc','',[rfReplaceAll,rfIgnoreCase]);
3525 FSortedFields:=StringReplace(FSortedFields,' Asc','',[rfReplaceAll,rfIgnoreCase]);
3527 FIndexFieldNames:=GetIndexFieldNames;
3529 if (FSortedFields = '') then
3530 Self.InternalRefresh
3536 function TZAbstractRODataset.GetIndexFieldNames : String;
3538 Result:=FSortedFields;
3539 if Result <> '' then
3540 begin {pawelsel modification}
3541 if FSortType = stAscending then
3543 Result:=StringReplace(Result,';',' Asc;',[rfReplaceAll]);
3544 Result:=StringReplace(Result,',',' Asc,',[rfReplaceAll]);
3545 Result:=Result+' Asc';
3547 if FSortType = stDescending then
3549 Result:=StringReplace(Result,';',' Desc;',[rfReplaceAll]);
3550 Result:=StringReplace(Result,',',' Desc,',[rfReplaceAll]);
3551 Result:=Result+' Desc';
3556 procedure TZAbstractRODataset.SetIndexFieldNames(Value: String);
3559 {pawelsel modification}
3560 Value:=StringReplace(Value,'[','',[rfReplaceAll]);
3561 Value:=StringReplace(Value,']','',[rfReplaceAll]);
3563 if FIndexFieldNames <> Value then
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]);
3572 FSortedFields:=Value;
3577 if (FSortedFields = '') then
3578 Self.InternalRefresh
3583 {====================end of bangfauzan addition====================}