00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Abstract Read/Only Dataset component }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZAbstractRODataset;
00055
00056 interface
00057
00058 {$I ZComponent.inc}
00059
00060 uses
00061 {$IFNDEF UNIX}
00062 Windows,
00063 {$ENDIF}
00064 {$IFNDEF VER130BELOW}
00065 Types,
00066 Variants,
00067 {$ENDIF}
00068 SysUtils, DB, Classes, ZSysUtils, ZConnection, ZDbcIntfs, ZSqlStrings,
00069 Contnrs, ZDbcCache, ZDbcCachedResultSet, ZCompatibility, ZExpression;
00070
00071 type
00072 {$IFDEF FPC}
00073 TUpdateStatusSet = set of TUpdateStatus;
00074
00075 EUpdateError = class(EDatabaseError)
00076 end;
00077 {$ENDIF}
00078
00079 TSortType = (stAscending, stDescending, stIgnored); {bangfauzan addition}
00080
00081 {** Options for dataset. }
00082 TZDatasetOption = (doOemTranslate, doCalcDefaults, doAlwaysDetailResync,
00083 doSmartOpen);
00084
00085 {** Set of dataset options. }
00086 TZDatasetOptions = set of TZDatasetOption;
00087
00088
00089 TZAbstractRODataset = class;
00090
00091 {** Implements a Zeos specific database exception with SQL error code. }
00092 EZDatabaseError = class(EDatabaseError)
00093 private
00094 FErrorCode: Integer;
00095 FStatusCode: String;
00096 procedure SetStatusCode(const Value: String);
00097 public
00098 constructor Create(const Msg: string);
00099 constructor CreateFromException(E: EZSQLThrowable);
00100
00101 property ErrorCode: Integer read FErrorCode write FErrorCode;
00102 property StatusCode: String read FStatusCode write SetStatusCode;
00103 end;
00104
00105 {** Dataset Linker class. }
00106 TZDataLink = class(TDataLink)
00107 private
00108 FDataset: TZAbstractRODataset;
00109 protected
00110 procedure ActiveChanged; override;
00111 procedure RecordChanged(Field: TField); override;
00112 public
00113 constructor Create(ADataset: TZAbstractRODataset);
00114 end;
00115
00116 {** Abstract dataset component optimized for read/only access. }
00117 TZAbstractRODataset = class(TDataSet)
00118 private
00119 {$IFDEF VER130BELOW}
00120 FUniDirectional: Boolean;
00121 {$ENDIF}
00122 FCurrentRow: Integer;
00123 FRowAccessor: TZRowAccessor;
00124 FOldRowBuffer: PZRowBuffer;
00125 FNewRowBuffer: PZRowBuffer;
00126 FCurrentRows: TZSortedList;
00127 FFetchCount: Integer;
00128 FFieldsLookupTable: TIntegerDynArray;
00129 FRowsAffected: Integer;
00130
00131 FFilterEnabled: Boolean;
00132 FFilterExpression: IZExpression;
00133 FFilterStack: TZExecutionStack;
00134 FFilterFieldRefs: TObjectDynArray;
00135 FInitFilterFields: Boolean;
00136
00137 FRequestLive: Boolean;
00138 FFetchRow: integer;
00139
00140 FSQL: TZSQLStrings;
00141 FParams: TParams;
00142 FShowRecordTypes: TUpdateStatusSet;
00143 FOptions: TZDatasetOptions;
00144
00145 FProperties: TStrings;
00146 FConnection: TZConnection;
00147 FStatement: IZPreparedStatement;
00148 FResultSet: IZResultSet;
00149
00150 FRefreshInProgress: Boolean;
00151
00152 FDataLink: TDataLink;
00153 FMasterLink: TMasterDataLink;
00154 FLinkedFields: string; {renamed by bangfauzan}
00155 FIndexFieldNames : String; {bangfauzan addition}
00156
00157 FIndexFields: TList;
00158
00159 FSortType : TSortType; {bangfauzan addition}
00160
00161 FSortedFields: string;
00162 FSortedFieldRefs: TObjectDynArray;
00163 FSortedFieldIndices: TIntegerDynArray;
00164 FSortedFieldDirs: TBooleanDynArray;
00165 FSortedOnlyDataFields: Boolean;
00166 FSortRowBuffer1: PZRowBuffer;
00167 FSortRowBuffer2: PZRowBuffer;
00168 private
00169 function GetReadOnly: Boolean;
00170 procedure SetReadOnly(Value: Boolean);
00171 function GetSQL: TStrings;
00172 procedure SetSQL(Value: TStrings);
00173 function GetParamCheck: Boolean;
00174 procedure SetParamCheck(Value: Boolean);
00175 procedure SetParams(Value: TParams);
00176 function GetShowRecordTypes: TUpdateStatusSet;
00177 procedure SetShowRecordTypes(Value: TUpdateStatusSet);
00178 procedure SetConnection(Value: TZConnection);
00179 procedure SetDataSource(Value: TDataSource);
00180 function GetMasterFields: string;
00181 procedure SetMasterFields(const Value: string);
00182 function GetMasterDataSource: TDataSource;
00183 procedure SetMasterDataSource(Value: TDataSource);
00184 function GetLinkedFields: string; {renamed by bangfauzan}
00185 procedure SetLinkedFields(const Value: string); {renamed by bangfauzan}
00186 function GetIndexFieldNames : String; {bangfauzan addition}
00187 procedure SetIndexFieldNames(Value : String); {bangfauzan addition}
00188 procedure SetOptions(Value: TZDatasetOptions);
00189 procedure SetSortedFields({const} Value: string); {bangfauzan modification}
00190 procedure SetProperties(const Value: TStrings);
00191
00192 function GetSortType : TSortType; {bangfauzan addition}
00193 Procedure SetSortType(Value : TSortType); {bangfauzan addition}
00194
00195 procedure UpdateSQLStrings(Sender: TObject);
00196 procedure ReadParamData(Reader: TReader);
00197 procedure WriteParamData(Writer: TWriter);
00198
00199 protected
00200 procedure CheckOpened;
00201 procedure CheckConnected;
00202 procedure CheckBiDirectional;
00203 procedure CheckSQLQuery; virtual;
00204 procedure RaiseReadOnlyError;
00205
00206 function FetchOneRow: Boolean;
00207 function FetchRows(RowCount: Integer): Boolean;
00208 function FilterRow(RowNo: Integer): Boolean;
00209 procedure RereadRows;
00210 procedure SetStatementParams(Statement: IZPreparedStatement;
00211 ParamNames: TStringDynArray; Params: TParams;
00212 DataLink: TDataLink); virtual;
00213 procedure MasterChanged(Sender: TObject);
00214 procedure MasterDisabled(Sender: TObject);
00215 procedure DoOnNewRecord; override;
00216
00217 function GetDataSource: TDataSource; override;
00218
00219 protected
00220 { Internal protected properties. }
00221 property RowAccessor: TZRowAccessor read FRowAccessor write FRowAccessor;
00222 property CurrentRow: Integer read FCurrentRow write FCurrentRow;
00223 property OldRowBuffer: PZRowBuffer read FOldRowBuffer write FOldRowBuffer;
00224 property NewRowBuffer: PZRowBuffer read FNewRowBuffer write FNewRowBuffer;
00225 property CurrentRows: TZSortedList read FCurrentRows write FCurrentRows;
00226 property FetchCount: Integer read FFetchCount write FFetchCount;
00227 property FieldsLookupTable: TIntegerDynArray read FFieldsLookupTable
00228 write FFieldsLookupTable;
00229
00230 property FilterEnabled: Boolean read FFilterEnabled write FFilterEnabled;
00231 property FilterExpression: IZExpression read FFilterExpression
00232 write FFilterExpression;
00233 property FilterStack: TZExecutionStack read FFilterStack write FFilterStack;
00234 property FilterFieldRefs: TObjectDynArray read FFilterFieldRefs
00235 write FFilterFieldRefs;
00236 property InitFilterFields: Boolean read FInitFilterFields
00237 write FInitFilterFields;
00238
00239 property Statement: IZPreparedStatement read FStatement write FStatement;
00240 property ResultSet: IZResultSet read FResultSet write FResultSet;
00241
00242 property DataLink: TDataLink read FDataLink;
00243 property MasterLink: TMasterDataLink read FMasterLink;
00244 property IndexFields: TList read FIndexFields;
00245
00246 { External protected properties. }
00247 property RequestLive: Boolean read FRequestLive write FRequestLive
00248 default False;
00249 property FetchRow: integer read FFetchRow write FFetchRow default 0;
00250 property SQL: TStrings read GetSQL write SetSQL;
00251 property ParamCheck: Boolean read GetParamCheck write SetParamCheck
00252 default True;
00253 property Params: TParams read FParams write SetParams;
00254 property ReadOnly: Boolean read GetReadOnly write SetReadOnly default True;
00255 property ShowRecordTypes: TUpdateStatusSet read GetShowRecordTypes
00256 write SetShowRecordTypes default [usUnmodified, usModified, usInserted];
00257 {$IFDEF VER130BELOW}
00258 property IsUniDirectional: Boolean read FUniDirectional
00259 write FUnidirectional default False;
00260 {$ENDIF}
00261 property Properties: TStrings read FProperties write SetProperties;
00262 property Options: TZDatasetOptions read FOptions write SetOptions
00263 default [doCalcDefaults];
00264 property DataSource: TDataSource read GetDataSource write SetDataSource;
00265 property MasterFields: string read GetMasterFields
00266 write SetMasterFields;
00267 property MasterSource: TDataSource read GetMasterDataSource
00268 write SetMasterDataSource;
00269 property LinkedFields: string read GetLinkedFields
00270 write SetLinkedFields; {renamed by bangfauzan}
00271 property IndexFieldNames:String read GetIndexFieldNames
00272 write SetIndexFieldNames; {bangfauzan addition}
00273
00274 protected
00275 { Abstracts methods }
00276 procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
00277 procedure InternalDelete; override;
00278 procedure InternalPost; override;
00279
00280 procedure SetFieldData(Field: TField; Buffer: Pointer;
00281 NativeFormat: Boolean); override;
00282 procedure SetFieldData(Field: TField; Buffer: Pointer); override;
00283 procedure DefineProperties(Filer: TFiler); override;
00284
00285 function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean):
00286 TGetResult; override;
00287 function GetRecordSize: Word; override;
00288 function GetActiveBuffer(var RowBuffer: PZRowBuffer): Boolean;
00289 function AllocRecordBuffer: PChar; override;
00290 procedure FreeRecordBuffer(var Buffer: PChar); override;
00291 procedure CloseBlob(Field: TField); override;
00292 function CreateStatement(const SQL: string; Properties: TStrings):
00293 IZPreparedStatement; virtual;
00294 function CreateResultSet(const SQL: string; MaxRows: Integer):
00295 IZResultSet; virtual;
00296
00297 procedure CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef);
00298 {$IFNDEF FPC}override;{$ENDIF}
00299 procedure ClearCalcFields(Buffer: PChar); override;
00300
00301 procedure InternalInitFieldDefs; override;
00302 procedure InternalOpen; override;
00303 procedure InternalClose; override;
00304 procedure InternalFirst; override;
00305 procedure InternalLast; override;
00306 procedure InternalInitRecord(Buffer: PChar); override;
00307 procedure InternalGotoBookmark(Bookmark: Pointer); override;
00308 procedure InternalRefresh; override;
00309 procedure InternalHandleException; override;
00310 procedure InternalSetToRecord(Buffer: PChar); override;
00311
00312 procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
00313 function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
00314 procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
00315 procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
00316
00317 function InternalLocate(const KeyFields: string; const KeyValues: Variant;
00318 Options: TLocateOptions): LongInt;
00319 function FindRecord(Restart, GoForward: Boolean): Boolean; override;
00320 procedure SetFiltered(Value: Boolean); override;
00321 procedure SetFilterText(const Value: string); override;
00322
00323 procedure InternalSort;
00324 function ClearSort(Item1, Item2: Pointer): Integer;
00325 function HighLevelSort(Item1, Item2: Pointer): Integer;
00326 function LowLevelSort(Item1, Item2: Pointer): Integer;
00327
00328 function GetCanModify: Boolean; override;
00329 function GetRecNo: Integer; override;
00330 function GetRecordCount: Integer; override;
00331 procedure MoveRecNo(Value: Integer);
00332 procedure SetRecNo(Value: Integer); override;
00333 function IsCursorOpen: Boolean; override;
00334
00335 procedure Notification(AComponent: TComponent;
00336 Operation: TOperation); override;
00337
00338 procedure RefreshParams;virtual;
00339
00340 protected
00341 {$IFDEF WITH_IPROVIDER}
00342 procedure PSStartTransaction; override;
00343 procedure PSEndTransaction(Commit: Boolean); override;
00344 {$IFDEF BDS4_UP}
00345 function PSGetTableNameW: WideString; override;
00346 function PSGetQuoteCharW: WideString; override;
00347 {$ELSE}
00348 function PSGetTableName: string; override;
00349 function PSGetQuoteChar: string; override;
00350 {$ENDIF}
00351 function PSGetUpdateException(E: Exception;
00352 Prev: EUpdateError): EUpdateError; override;
00353 function PSIsSQLBased: Boolean; override;
00354 function PSIsSQLSupported: Boolean; override;
00355 procedure PSReset; override;
00356 function PSUpdateRecord(UpdateKind: TUpdateKind;
00357 Delta: TDataSet): Boolean; override;
00358 procedure PSExecute; override;
00359 {$IFDEF BDS4_UP}
00360 function PSGetKeyFieldsW: WideString; override;
00361 {$ELSE}
00362 function PSGetKeyFields: string; override;
00363 {$ENDIF}
00364 function PSGetParams: TParams; override;
00365 procedure PSSetParams(AParams: TParams); override;
00366 function PSExecuteStatement(const ASQL: string; AParams: TParams;
00367 ResultSet: Pointer = nil): Integer; override;
00368 function PSInTransaction: Boolean; override;
00369 procedure PSSetCommandText(const CommandText: string); override;
00370 {$ENDIF}
00371
00372 public
00373 constructor Create(AOwner: TComponent); override;
00374 destructor Destroy; override;
00375
00376 procedure FetchAll; virtual;
00377 procedure ExecSQL; virtual;
00378 function RowsAffected: LongInt;
00379 function ParamByName(const Value: string): TParam;
00380
00381 function Locate(const KeyFields: string; const KeyValues: Variant;
00382 Options: TLocateOptions): Boolean; override;
00383 function Lookup(const KeyFields: string; const KeyValues: Variant;
00384 const ResultFields: string): Variant; override;
00385 function IsSequenced: Boolean; override;
00386
00387 function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
00388 override;
00389 function BookmarkValid(Bookmark: TBookmark): Boolean; override;
00390
00391 function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
00392 function GetFieldData(Field: TField; Buffer: Pointer;
00393 NativeFormat: Boolean): Boolean; override;
00394 function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
00395 override;
00396 function UpdateStatus: TUpdateStatus; override;
00397 function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; override;
00398
00399 public
00400 property Active;
00401 property FieldDefs stored False;
00402 property DbcStatement: IZPreparedStatement read FStatement;
00403 property DbcResultSet: IZResultSet read FResultSet;
00404
00405 published
00406 property Connection: TZConnection read FConnection write SetConnection;
00407 property SortedFields: string read FSortedFields write SetSortedFields;
00408 property SortType : TSortType read FSortType write SetSortType
00409 default stAscending; {bangfauzan addition}
00410
00411 property AutoCalcFields;
00412 property BeforeOpen;
00413 property AfterOpen;
00414 property BeforeClose;
00415 property AfterClose;
00416 {$IFNDEF FPC}
00417 property BeforeRefresh;
00418 property AfterRefresh;
00419 {$ENDIF}
00420 {$IFDEF FPC2_UP}
00421 property BeforeRefresh;
00422 property AfterRefresh;
00423 {$ENDIF}
00424 property BeforeScroll;
00425 property AfterScroll;
00426 property OnCalcFields;
00427 property OnFilterRecord;
00428 property Filter;
00429 property Filtered;
00430 end;
00431
00432 implementation
00433
00434 uses Math, ZVariant, ZMessages, ZDatasetUtils, ZStreamBlob, ZSelectSchema,
00435 ZGenericSqlToken, ZTokenizer, ZGenericSqlAnalyser, ZAbstractDataset
00436 {$IFNDEF FPC}, DBConsts{$ENDIF}
00437 {$IFDEF BDS4_UP}, WideStrUtils{$ENDIF};
00438
00439 { EZDatabaseError }
00440
00441 {**
00442 Constructs a database exception with a string message.
00443 @param Msg a string message which describes the error.
00444 }
00445 constructor EZDatabaseError.Create(const Msg: string);
00446 begin
00447 inherited Create(Msg);
00448 end;
00449
00450 {**
00451 Constructs a database exception from TZSQLThrowable instance.
00452 @param E an original TZSQLThrowable instance.
00453 }
00454 constructor EZDatabaseError.CreateFromException(E: EZSQLThrowable);
00455 begin
00456 inherited Create(E.Message);
00457 ErrorCode := E.ErrorCode;
00458 Statuscode:= E.StatusCode;
00459 end;
00460
00461 procedure EZDatabaseError.SetStatusCode(const Value: String);
00462 begin
00463 FStatusCode:=value;
00464 end;
00465
00466 { procedure EZDatabaseError.SetStatusCode(const Value: String);
00467 begin
00468 FStatusCode := Value;
00469 end;
00470
00471 TZDataLink }
00472
00473 {**
00474 Creates this dataset link object.
00475 @param ADataset an owner linked dataset component.
00476 }
00477 constructor TZDataLink.Create(ADataset: TZAbstractRODataset);
00478 begin
00479 inherited Create;
00480 FDataset := ADataset;
00481 end;
00482
00483 {**
00484 Processes changes in state of linked dataset.
00485 }
00486 procedure TZDataLink.ActiveChanged;
00487 begin
00488 if FDataset.Active then
00489 FDataset.RefreshParams;
00490 end;
00491
00492 {**
00493 Processes changes in fields of the linked dataset.
00494 @param Field a field which was changed.
00495 }
00496 procedure TZDataLink.RecordChanged(Field: TField);
00497 begin
00498 if (Field = nil) and FDataset.Active then
00499 FDataset.RefreshParams;
00500 end;
00501
00502 { TZAbstractRODataset }
00503
00504 {**
00505 Constructs this object and assignes the mail properties.
00506 @param AOwner a component owner.
00507 }
00508 constructor TZAbstractRODataset.Create(AOwner: TComponent);
00509 begin
00510 inherited Create(AOwner);
00511
00512 FSQL := TZSQLStrings.Create;
00513 TZSQLStrings(FSQL).Dataset := Self;
00514 TZSQLStrings(FSQL).MultiStatements := False;
00515 FSQL.OnChange := UpdateSQLStrings;
00516 FParams := TParams.Create(Self);
00517 FCurrentRows := TZSortedList.Create;
00518 BookmarkSize := SizeOf(Integer);
00519 FShowRecordTypes := [usModified, usInserted, usUnmodified];
00520 FRequestLive := False;
00521 FFetchRow := 0;
00522 FOptions := [doCalcDefaults];
00523
00524 FFilterEnabled := False;
00525 FProperties := TStringList.Create;
00526 FFilterExpression := TZExpression.Create;
00527 FFilterExpression.Tokenizer := CommonTokenizer;
00528 FFilterStack := TZExecutionStack.Create;
00529
00530 FDataLink := TZDataLink.Create(Self);
00531 FMasterLink := TMasterDataLink.Create(Self);
00532 FMasterLink.OnMasterChange := MasterChanged;
00533 FMasterLink.OnMasterDisable := MasterDisabled;
00534 FIndexFields := TList.Create;
00535 end;
00536
00537 {**
00538 Destroys this object and cleanups the memory.
00539 }
00540 destructor TZAbstractRODataset.Destroy;
00541 begin
00542 if Assigned(Connection) then
00543 begin
00544 try
00545 SetConnection(nil);
00546 except
00547 end;
00548 end;
00549
00550 FreeAndNil(FSQL);
00551 FreeAndNil(FParams);
00552 FreeAndNil(FCurrentRows);
00553 FreeAndNil(FProperties);
00554 FreeAndNil(FFilterStack);
00555
00556 FreeAndNil(FDataLink);
00557 FreeAndNil(FMasterLink);
00558 FreeAndNil(FIndexFields);
00559
00560 inherited Destroy;
00561 end;
00562
00563 {**
00564 Sets database connection object.
00565 @param Value a database connection object.
00566 }
00567 procedure TZAbstractRODataset.SetConnection(Value: TZConnection);
00568 begin
00569 if FConnection <> Value then
00570 begin
00571 if Active then Close;
00572 Statement := nil;
00573 if FConnection <> nil then
00574 FConnection.UnregisterDataSet(Self);
00575 FConnection := Value;
00576 if FConnection <> nil then
00577 FConnection.RegisterDataSet(Self);
00578 end;
00579 end;
00580
00581 {**
00582 Gets the SQL query.
00583 @return the SQL query strings.
00584 }
00585
00586 function TZAbstractRODataset.GetSQL: TStrings;
00587 begin
00588 Result := FSQL;
00589 end;
00590
00591 {**
00592 Sets a new SQL query.
00593 @param Value a new SQL query.
00594 }
00595 procedure TZAbstractRODataset.SetSQL(Value: TStrings);
00596 begin
00597 FSQL.Assign(Value);
00598 end;
00599
00600 {**
00601 Gets a parameters check value.
00602 @return a parameters check value.
00603 }
00604 function TZAbstractRODataset.GetParamCheck: Boolean;
00605 begin
00606 Result := FSQL.ParamCheck;
00607 end;
00608
00609 {**
00610 Sets a new parameters check value.
00611 @param Value a parameters check value.
00612 }
00613 procedure TZAbstractRODataset.SetParamCheck(Value: Boolean);
00614 begin
00615 FSQL.ParamCheck := Value;
00616 UpdateSQLStrings(Self);
00617 end;
00618
00619 {**
00620 Sets a new set of parameters.
00621 @param Value a set of parameters.
00622 }
00623 procedure TZAbstractRODataset.SetParams(Value: TParams);
00624 begin
00625 FParams.AssignValues(Value);
00626 end;
00627
00628 {**
00629 Defines a persistent dataset properties.
00630 @param Filer a persistent manager object.
00631 }
00632 procedure TZAbstractRODataset.DefineProperties(Filer: TFiler);
00633
00634 function WriteData: Boolean;
00635 begin
00636 if Filer.Ancestor <> nil then
00637 Result := not FParams.IsEqual(TZAbstractRODataset(Filer.Ancestor).FParams)
00638 else Result := FParams.Count > 0;
00639 end;
00640
00641 begin
00642 inherited DefineProperties(Filer);
00643 Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
00644 end;
00645
00646 {**
00647 Reads parameter data from persistent storage.
00648 @param Reader an input data stream.
00649 }
00650 procedure TZAbstractRODataset.ReadParamData(Reader: TReader);
00651 begin
00652 Reader.ReadValue;
00653 Reader.ReadCollection(FParams);
00654 end;
00655
00656 {**
00657 Writes parameter data from persistent storage.
00658 @param Writer an output data stream.
00659 }
00660 procedure TZAbstractRODataset.WriteParamData(Writer: TWriter);
00661 begin
00662 Writer.WriteCollection(Params);
00663 end;
00664
00665 {**
00666 Gets a SQL parameter by its name.
00667 @param Value a parameter name.
00668 @return a found parameter object.
00669 }
00670 function TZAbstractRODataset.ParamByName(const Value: string): TParam;
00671 begin
00672 Result := FParams.ParamByName(Value);
00673 end;
00674
00675 {**
00676 Updates parameters from SQL statement.
00677 @param Sender an event sender object.
00678 }
00679 procedure TZAbstractRODataset.UpdateSQLStrings(Sender: TObject);
00680 var
00681 I: Integer;
00682 OldParams: TParams;
00683 begin
00684 FieldDefs.Clear;
00685 if Active then
00686 Close
00687 else Statement := nil;
00688
00689 OldParams := TParams.Create;
00690 OldParams.Assign(FParams);
00691 FParams.Clear;
00692
00693 try
00694 for I := 0 to FSQL.ParamCount - 1 do
00695 FParams.CreateParam(ftUnknown, FSQL.ParamNames[I], ptUnknown);
00696 FParams.AssignValues(OldParams);
00697 finally
00698 OldParams.Free;
00699 end;
00700 end;
00701
00702 {**
00703 Gets the ReadOnly property.
00704 @return <code>True</code> if the opened result set read only.
00705 }
00706 function TZAbstractRODataset.GetReadOnly: Boolean;
00707 begin
00708 Result := not RequestLive;
00709 end;
00710
00711 {**
00712 Sets a new ReadOnly property.
00713 @param Value <code>True</code> to set result set read-only.
00714 }
00715 procedure TZAbstractRODataset.SetReadOnly(Value: Boolean);
00716 begin
00717 RequestLive := not Value;
00718 end;
00719
00720 {**
00721 Gets a visible updated records types.
00722 @param return visible UpdateRecordTypes value.
00723 }
00724 function TZAbstractRODataset.GetShowRecordTypes: TUpdateStatusSet;
00725 begin
00726 Result := FShowRecordTypes;
00727 end;
00728
00729 {**
00730 Sets a new visible updated records types.
00731 @param Value a new visible UpdateRecordTypes value.
00732 }
00733 procedure TZAbstractRODataset.SetShowRecordTypes(Value: TUpdateStatusSet);
00734 begin
00735 if Value <> FShowRecordTypes then
00736 begin
00737 FShowRecordTypes := Value;
00738 RereadRows;
00739 end;
00740 end;
00741
00742 {**
00743 Checks if this dataset is opened.
00744 }
00745 procedure TZAbstractRODataset.CheckOpened;
00746 begin
00747 if not Active then
00748 DatabaseError(SOperationIsNotAllowed4);
00749 end;
00750
00751 {**
00752 Checks if the database connection is assigned
00753 and tries to connect.
00754 }
00755 procedure TZAbstractRODataset.CheckConnected;
00756 begin
00757 if Connection = nil then
00758 raise EZDatabaseError.Create(SConnectionIsNotAssigned);
00759 Connection.Connect;
00760 end;
00761
00762 {**
00763 Checks is the database has bidirectional access.
00764 }
00765 procedure TZAbstractRODataset.CheckBiDirectional;
00766 begin
00767 if IsUniDirectional then
00768 raise EZDatabaseError.Create(SOperationIsNotAllowed1);
00769 end;
00770
00771 {**
00772 Checks the correct SQL query.
00773 }
00774 procedure TZAbstractRODataset.CheckSQLQuery;
00775 begin
00776 if FSQL.StatementCount < 1 then
00777 raise EZDatabaseError.Create(SQueryIsEmpty);
00778 if FSQL.StatementCount > 1 then
00779 raise EZDatabaseError.Create(SCanNotExecuteMoreQueries);
00780 end;
00781
00782 {**
00783 Raises an error 'Operation is not allowed in read-only dataset.
00784 }
00785 procedure TZAbstractRODataset.RaiseReadOnlyError;
00786 begin
00787 raise EZDatabaseError.Create(SOperationIsNotAllowed2);
00788 end;
00789
00790 {**
00791 Fetches specified number of records.
00792 @param RowCount a specified number of rows to be fetched.
00793 @return <code>True</code> if all required rows were fetched.
00794 }
00795 function TZAbstractRODataset.FetchRows(RowCount: Integer): Boolean;
00796 begin
00797 Connection.ShowSQLHourGlass;
00798 try
00799 if RowCount = 0 then
00800 begin
00801 while FetchOneRow do;
00802 Result := True;
00803 end
00804 else
00805 begin
00806 while (CurrentRows.Count < RowCount) do
00807 begin
00808 if not FetchOneRow then
00809 Break;
00810 end;
00811 Result := CurrentRows.Count >= RowCount;
00812 end;
00813 finally
00814 Connection.HideSQLHourGlass;
00815 end;
00816 end;
00817
00818 {**
00819 Fetches one row from the result set.
00820 @return <code>True</code> if record was successfully fetched.
00821 }
00822 function TZAbstractRODataset.FetchOneRow: Boolean;
00823 begin
00824 repeat
00825 if (FetchCount = 0) or (ResultSet.GetRow = FetchCount)
00826 or ResultSet.MoveAbsolute(FetchCount) then
00827 Result := ResultSet.Next
00828 else Result := False;
00829 if Result then
00830 begin
00831 Inc(FFetchCount);
00832 if FilterRow(ResultSet.GetRow) then
00833 CurrentRows.Add(Pointer(ResultSet.GetRow))
00834 else Continue;
00835 end;
00836 until True;
00837 end;
00838
00839 {**
00840 Checks the specified row with the all filters.
00841 @param RowNo a number of the row.
00842 @return <code>True</code> if the row sutisfy to all filters.
00843 }
00844 function TZAbstractRODataset.FilterRow(RowNo: Integer): Boolean;
00845 var
00846 I: Integer;
00847 SavedRow: Integer;
00848 SavedRows: TZSortedList;
00849 SavedState: TDatasetState;
00850 begin
00851 Result := True;
00852
00853 { Locates the result set to the specified row. }
00854 if ResultSet.GetRow <> RowNo then
00855 begin
00856 if not ResultSet.MoveAbsolute(RowNo) then
00857 Result := False;
00858 end;
00859 if not Result then Exit;
00860
00861 { Checks record by ShowRecordType }
00862 if ResultSet.RowUpdated then
00863 Result := usModified in ShowRecordTypes
00864 else if ResultSet.RowInserted then
00865 Result := usInserted in ShowRecordTypes
00866 else if ResultSet.RowDeleted then
00867 Result := usDeleted in ShowRecordTypes
00868 else Result := usUnmodified in ShowRecordTypes;
00869 if not Result then Exit;
00870
00871 { Check master-detail links }
00872 if MasterLink.Active then
00873 begin
00874 for I := 0 to MasterLink.Fields.Count - 1 do
00875 begin
00876 if I < IndexFields.Count then
00877 begin
00878 Result := CompareKeyFields(TField(IndexFields[I]), ResultSet,
00879 TField(MasterLink.Fields[I]));
00880 end;
00881
00882 if not Result then
00883 Break;
00884 end;
00885 end;
00886 if not Result then Exit;
00887
00888 { Checks record by OnFilterRecord event }
00889 if FilterEnabled and Assigned(OnFilterRecord) then
00890 begin
00891 SavedRow := CurrentRow;
00892 SavedRows := CurrentRows;
00893 CurrentRows := TZSortedList.Create;
00894
00895 SavedState := SetTempState(dsNewValue);
00896 CurrentRows.Add(Pointer(RowNo));
00897 CurrentRow := 1;
00898
00899 try
00900 OnFilterRecord(Self, Result);
00901 except
00902 {$IFNDEF VER130BELOW}
00903 ApplicationHandleException(Self);
00904 {$ELSE}
00905 ShowException(ExceptObject, ExceptAddr);
00906 {$ENDIF}
00907 end;
00908
00909 CurrentRow := SavedRow;
00910 CurrentRows.Free;
00911 CurrentRows := SavedRows;
00912 RestoreState(SavedState);
00913
00914 end;
00915 if not Result then Exit;
00916
00917 { Check the record by filter expression. }
00918 if FilterEnabled and (FilterExpression.Expression <> '') then
00919 begin
00920 if not InitFilterFields then
00921 begin
00922 FilterFieldRefs := DefineFilterFields(Self, FilterExpression);
00923 InitFilterFields := True;
00924 end;
00925 CopyDataFieldsToVars(FilterFieldRefs, ResultSet,
00926 FilterExpression.DefaultVariables);
00927 Result := FilterExpression.VariantManager.GetAsBoolean(
00928 FilterExpression.Evaluate4(FilterExpression.DefaultVariables,
00929 FilterExpression.DefaultFunctions, FilterStack));
00930 end;
00931 if not Result then Exit;
00932 end;
00933
00934 {**
00935 Rereads all rows and applies a filter.
00936 }
00937 procedure TZAbstractRODataset.RereadRows;
00938 var
00939 I, RowNo: Integer;
00940 begin
00941 if not (State in [dsInactive]) and not IsUniDirectional then
00942 begin
00943 if (CurrentRow > 0) and (CurrentRow <= CurrentRows.Count) and
00944 (CurrentRows.Count > 0) then
00945 RowNo := Integer(CurrentRows[CurrentRow - 1])
00946 else RowNo := -1;
00947 CurrentRows.Clear;
00948
00949 for I := 1 to FetchCount do
00950 begin
00951 if FilterRow(I) then
00952 CurrentRows.Add(Pointer(I));
00953 end;
00954
00955 CurrentRow := CurrentRows.IndexOf(Pointer(RowNo)) + 1;
00956 CurrentRow := Min(Max(1, CurrentRow), CurrentRows.Count);
00957
00958 if FSortedFields <> '' then
00959 InternalSort
00960 else Resync([]);
00961 end;
00962 end;
00963
00964 {**
00965 Fill prepared statement with parameters.
00966 @param Statement a prepared SQL statement.
00967 @param ParamNames an array of parameter names.
00968 @param Params a collection of SQL parameters.
00969 @param DataLink a datalink to get parameters.
00970 }
00971 procedure TZAbstractRODataset.SetStatementParams(Statement: IZPreparedStatement;
00972 ParamNames: TStringDynArray; Params: TParams; DataLink: TDataLink);
00973 var
00974 I: Integer;
00975 TempParam, Param: TParam;
00976 Stream: TStream;
00977 Dataset: TDataset;
00978 Field: TField;
00979 begin
00980 if DataLink.Active then
00981 Dataset := DataLink.DataSet
00982 else Dataset := nil;
00983
00984 TempParam := TParam.Create(nil);
00985
00986 try
00987 for I := Low(ParamNames) to High(ParamNames) do
00988 begin
00989 if Assigned(Dataset) then
00990 Field := Dataset.FindField(ParamNames[I])
00991 else Field := nil;
00992
00993 if Assigned(Field) then
00994 begin
00995 TempParam.AssignField(Field);
00996 Param := TempParam;
00997 end
00998 else
00999 begin
01000 Param := Params.FindParam(ParamNames[I]);
01001 if not Assigned(Param) or (Param.ParamType in [ptOutput, ptResult]) then
01002 Continue;
01003 end;
01004
01005 if Param.IsNull then begin
01006 Statement.SetNull(I + 1, ConvertDatasetToDbcType(Param.DataType))
01007 end else begin
01008 case Param.DataType of
01009 ftBoolean:
01010 Statement.SetBoolean(I + 1, Param.AsBoolean);
01011 ftSmallInt:
01012 Statement.SetShort(I + 1, Param.AsSmallInt);
01013 ftInteger, ftAutoInc:
01014 Statement.SetInt(I + 1, Param.AsInteger);
01015 ftFloat:
01016 Statement.SetDouble(I + 1, Param.AsFloat);
01017 ftLargeInt:
01018 Statement.SetLong(I + 1, StrToInt64(Param.AsString));
01019 ftCurrency:
01020 Statement.SetBigDecimal(I + 1, Param.AsCurrency);
01021 ftString:
01022 Statement.SetString(I + 1, Param.AsString);
01023 ftBytes:
01024 Statement.SetString(I + 1, Param.AsString);
01025 ftDate:
01026 Statement.SetDate(I + 1, Param.AsDate);
01027 ftTime:
01028 Statement.SetTime(I + 1, Param.AsTime);
01029 ftDateTime{$IFNDEF VER130}, ftTimestamp{$ENDIF}:
01030 Statement.SetTimestamp(I + 1, Param.AsDateTime);
01031 ftMemo:
01032 begin
01033 Stream := TStringStream.Create(Param.AsMemo);
01034 try
01035 Statement.SetAsciiStream(I + 1, Stream);
01036 finally
01037 Stream.Free;
01038 end;
01039 end;
01040 ftBlob, ftGraphic:
01041 begin
01042 Stream := TStringStream.Create(Param.AsBlob);
01043 try
01044 Statement.SetBinaryStream(I + 1, Stream);
01045 finally
01046 Stream.Free;
01047 end;
01048 end;
01049 end;
01050 end;
01051 end;
01052 finally
01053 TempParam.Free;
01054 end;
01055 end;
01056
01057 {**
01058 Locates a specified record in dataset.
01059 @param Buffer a record buffer to put the contents of the row.
01060 @param GetMode a location mode.
01061 @param DoCheck flag to perform checking.
01062 @return a location result.
01063 }
01064 function TZAbstractRODataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
01065 DoCheck: Boolean): TGetResult;
01066 var
01067 RowNo: Integer;
01068 begin
01069 Result := grOK;
01070 case GetMode of
01071 gmNext:
01072 begin
01073 if FetchRows(CurrentRow + 1) then
01074 CurrentRow := CurrentRow + 1
01075 else Result := grEOF;
01076 end;
01077 gmPrior:
01078 begin
01079 CheckBiDirectional;
01080 if (CurrentRow > 1) and (CurrentRows.Count > 0) then
01081 CurrentRow := CurrentRow - 1
01082 else Result := grBOF;
01083 end;
01084 gmCurrent:
01085 begin
01086 if CurrentRow < CurrentRows.Count then
01087 CheckBiDirectional;
01088
01089 if CurrentRow = 0 then
01090 begin
01091 if CurrentRows.Count = 0 then
01092 FetchRows(1);
01093 CurrentRow := Min(CurrentRows.Count, 1);
01094 end
01095 else if not FetchRows(CurrentRow) then
01096 CurrentRow := Max(1, Min(CurrentRows.Count, CurrentRow));
01097
01098 if CurrentRows.Count = 0 then
01099 Result := grError;
01100 end;
01101 end;
01102
01103 if Result = grOK then
01104 begin
01105 RowNo := Integer(CurrentRows[CurrentRow - 1]);
01106 if ResultSet.GetRow <> RowNo then
01107 ResultSet.MoveAbsolute(RowNo);
01108 RowAccessor.RowBuffer := PZRowBuffer(Buffer);
01109 RowAccessor.RowBuffer^.Index := RowNo;
01110 FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
01111 FRowAccessor.RowBuffer^.BookmarkFlag := Ord(bfCurrent);
01112 GetCalcFields(Buffer);
01113 end;
01114
01115 if (Result = grError) and DoCheck then
01116 raise EZDatabaseError.Create(SNoMoreRecords);
01117 end;
01118
01119 {**
01120 Gets the current record buffer depended on the current dataset state.
01121 @param RowBuffer a reference to the result row buffer.
01122 @return <code>True</code> if the buffer was defined.
01123 }
01124 function TZAbstractRODataset.GetActiveBuffer(var RowBuffer: PZRowBuffer):
01125 Boolean;
01126 var
01127 RowNo: Integer;
01128 CachedResultSet: IZCachedResultSet;
01129 begin
01130 RowBuffer := nil;
01131 case State of
01132 dsBrowse,dsblockread:
01133 if not IsEmpty then
01134 RowBuffer := PZRowBuffer(ActiveBuffer);
01135 dsEdit, dsInsert:
01136 RowBuffer := PZRowBuffer(ActiveBuffer);
01137 dsCalcFields:
01138 RowBuffer := PZRowBuffer(CalcBuffer);
01139 dsOldValue, dsNewValue, dsCurValue:
01140 begin
01141 RowNo := Integer(CurrentRows[CurrentRow - 1]);
01142 if RowNo <> ResultSet.GetRow then
01143 CheckBiDirectional;
01144
01145 if State = dsOldValue then
01146 RowBuffer := OldRowBuffer
01147 else RowBuffer := NewRowBuffer;
01148
01149 if RowBuffer.Index <> RowNo then
01150 begin
01151 RowAccessor.RowBuffer := RowBuffer;
01152 RowAccessor.Clear;
01153 if (ResultSet.GetRow = RowNo) or ResultSet.MoveAbsolute(RowNo) then
01154 begin
01155 if (State = dsOldValue) and (ResultSet.
01156 QueryInterface(IZCachedResultSet, CachedResultSet) = 0) then
01157 CachedResultSet.MoveToInitialRow;
01158 FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
01159 RowBuffer.Index := RowNo;
01160 ResultSet.MoveToCurrentRow;
01161 end else
01162 RowBuffer := nil;
01163 end;
01164 end;
01165 end;
01166 Result := RowBuffer <> nil;
01167 end;
01168
01169 function TZAbstractRODataset.GetFieldData(Field: TField; Buffer: Pointer;
01170 NativeFormat: Boolean): Boolean;
01171 begin
01172 if Field.DataType = ftWideString then
01173 NativeFormat := True;
01174 Result := inherited GetFieldData(Field, Buffer, NativeFormat);
01175 end;
01176
01177 {**
01178 Retrieves the column value and stores it into the field buffer.
01179 @param Field an field object to be retrieved.
01180 @param Buffer a field value buffer.
01181 @return <code>True</code> if non-null value was retrieved.
01182 }
01183 function TZAbstractRODataset.GetFieldData(Field: TField;
01184 Buffer: Pointer): Boolean;
01185 var
01186 ColumnIndex: Integer;
01187 RowBuffer: PZRowBuffer;
01188 begin
01189 if GetActiveBuffer(RowBuffer) then
01190 begin
01191 ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
01192 RowAccessor.RowBuffer := RowBuffer;
01193 if Buffer <> nil then
01194 begin
01195 case Field.DataType of
01196 { Processes DateTime fields. }
01197 ftDate, ftTime, ftDateTime:
01198 begin
01199 if Field.DataType <> ftTime then
01200 begin
01201 DateTimeToNative(Field.DataType,
01202 RowAccessor.GetTimestamp(ColumnIndex, Result), Buffer);
01203 Result := not Result;
01204 end
01205 else
01206 begin
01207 DateTimeToNative(Field.DataType,
01208 RowAccessor.GetTime(ColumnIndex, Result), Buffer);
01209 Result := not Result;
01210 end;
01211 end;
01212 { Processes binary array fields. }
01213 ftBytes:
01214 begin
01215 PVariant(Buffer)^ := BytesToVar(
01216 RowAccessor.GetBytes(ColumnIndex, Result));
01217 System.Move((PChar(RowAccessor.GetColumnData(ColumnIndex, Result)) + 2)^, Buffer^,
01218 RowAccessor.GetColumnDataSize(ColumnIndex)-2);
01219 Result := not Result;
01220 end;
01221 { Processes blob fields. }
01222 ftBlob, ftMemo, ftGraphic, ftFmtMemo:
01223 begin
01224 Result := not RowAccessor.GetBlob(ColumnIndex, Result).IsEmpty;
01225 end;
01226 ftWideString:
01227 begin
01228 {$IFDEF BDS4_UP}
01229 WStrCopy(Buffer, PWideChar(RowAccessor.GetUnicodeString(ColumnIndex, Result)));
01230 {$ELSE}
01231 PWideString(Buffer)^ := RowAccessor.GetUnicodeString(ColumnIndex, Result);
01232 {$ENDIF}
01233 Result := not Result;
01234 end;
01235 { Processes all other fields. }
01236 else
01237 begin
01238 System.Move(RowAccessor.GetColumnData(ColumnIndex, Result)^, Buffer^,
01239 RowAccessor.GetColumnDataSize(ColumnIndex));
01240 Result := not Result;
01241 end;
01242 end;
01243 end
01244 else
01245 begin
01246 if Field.DataType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo] then
01247 Result := not RowAccessor.GetBlob(ColumnIndex, Result).IsEmpty
01248 else Result := not RowAccessor.IsNull(ColumnIndex);
01249 end;
01250 end else
01251 Result := False;
01252 end;
01253
01254 {**
01255 Support for widestring field
01256 }
01257 procedure TZAbstractRODataset.SetFieldData(Field: TField; Buffer: Pointer;
01258 NativeFormat: Boolean);
01259 begin
01260 if Field.DataType = ftWideString then
01261 NativeFormat := True;
01262 {$IFNDEF FPC}
01263 inherited;
01264 {$ELSE}
01265 SetFieldData(Field, Buffer);
01266 {$ENDIF}
01267 end;
01268
01269 {**
01270 Stores the column value from the field buffer.
01271 @param Field an field object to be stored.
01272 @param Buffer a field value buffer.
01273 }
01274 procedure TZAbstractRODataset.SetFieldData(Field: TField; Buffer: Pointer);
01275 var
01276 ColumnIndex: Integer;
01277 RowBuffer: PZRowBuffer;
01278 WasNull: Boolean;
01279 begin
01280 WasNull := False;
01281 if not Active then
01282 raise EZDatabaseError.Create(SOperationIsNotAllowed4);
01283 if not RequestLive and (Field.FieldKind = fkData) then
01284 RaiseReadOnlyError;
01285 // Check for readonly updates
01286 // Lookup values are requeried automatically on edit of all fields.
01287 // Didn't find a way to avoid this...
01288 if Field.ReadOnly and (Field.FieldKind <> fkLookup)
01289 and not (State in [dsSetKey, dsCalcFields, dsFilter, dsBlockRead, dsInternalCalc, dsOpening]) then
01290 DatabaseErrorFmt(SFieldReadOnly, [Field.DisplayName]);
01291 if not (State in dsWriteModes) then
01292 DatabaseError(SNotEditing, Self);
01293
01294 if GetActiveBuffer(RowBuffer) then
01295 begin
01296 ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
01297 RowAccessor.RowBuffer := RowBuffer;
01298
01299 if State in [dsEdit, dsInsert] then
01300 Field.Validate(Buffer);
01301
01302 if Buffer <> nil then
01303 begin
01304 { Processes DateTime fields. }
01305 if Field.DataType in [ftDate, ftDateTime] then
01306 begin
01307 RowAccessor.SetTimestamp(ColumnIndex, NativeToDateTime(Field.DataType,
01308 Buffer));
01309 end
01310 { Processes Time fields. }
01311 else if Field.DataType = ftTime then
01312 begin
01313 RowAccessor.SetTime(ColumnIndex, NativeToDateTime(Field.DataType,
01314 Buffer));
01315 end
01316 { Processes binary array fields. }
01317 else if Field.DataType = ftBytes then
01318 begin
01319 RowAccessor.SetBytes(ColumnIndex, VarToBytes(PVariant(Buffer)^));
01320 end
01321 { Processes widestring fields. }
01322 else if Field.DataType = ftWideString then
01323 begin
01324 {$IFDEF BDS4_UP}
01325 RowAccessor.SetUnicodeString(ColumnIndex, PWideChar(Buffer));
01326 {$ELSE}
01327 {$IFDEF FPC2_1UP}
01328 RowAccessor.SetUnicodeString(ColumnIndex, PWideChar(Buffer));
01329 {$ELSE}
01330 RowAccessor.SetUnicodeString(ColumnIndex, PWideString(Buffer)^);
01331 {$ENDIF}
01332 {$ENDIF}
01333
01334 end
01335 { Processes all other fields. }
01336 else if (Field.FieldKind = fkData) and (Field.DataType = ftString) and
01337 (Length(PChar(Buffer)) < RowAccessor.GetColumnDataSize(ColumnIndex)) then
01338 begin
01339 System.Move(Buffer^, RowAccessor.GetColumnData(ColumnIndex, WasNull)^,
01340 Length(PChar(Buffer)) + 1);
01341 RowAccessor.SetNotNull(ColumnIndex);
01342 end
01343 else
01344 begin
01345 System.Move(Buffer^, RowAccessor.GetColumnData(ColumnIndex, WasNull)^,
01346 RowAccessor.GetColumnDataSize(ColumnIndex));
01347 RowAccessor.SetNotNull(ColumnIndex);
01348 end;
01349 end else
01350 RowAccessor.SetNull(ColumnIndex);
01351
01352 if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
01353 DataEvent(deFieldChange, LongInt(Field));
01354 end else
01355 raise EZDatabaseError.Create(SRowDataIsNotAvailable);
01356
01357 if Field.FieldKind = fkData then
01358 begin
01359 OldRowBuffer.Index := -1;
01360 NewRowBuffer.Index := -1;
01361 end;
01362 end;
01363
01364 {**
01365 Checks is the cursor opened.
01366 @return <code>True</code> if the cursor is opened.
01367 }
01368 function TZAbstractRODataset.IsCursorOpen: Boolean;
01369 begin
01370 Result := ResultSet <> nil;
01371 end;
01372
01373 {**
01374 Gets an affected rows by the last executed statement.
01375 @return a number of last updated rows.
01376 }
01377 function TZAbstractRODataset.RowsAffected: LongInt;
01378 begin
01379 Result := FRowsAffected;
01380 end;
01381
01382 {**
01383 Gets the size of the record buffer.
01384 @return the size of the record buffer.
01385 }
01386 function TZAbstractRODataset.GetRecordSize: Word;
01387 begin
01388 Result := RowAccessor.RowSize;
01389 end;
01390
01391 {**
01392 Allocates a buffer for new record.
01393 @return an allocated record buffer.
01394 }
01395 function TZAbstractRODataset.AllocRecordBuffer: PChar;
01396 begin
01397 Result := PChar(RowAccessor.Alloc);
01398 end;
01399
01400 {**
01401 Frees a previously allocated record buffer.
01402 @param Buffer a previously allocated buffer.
01403 }
01404 procedure TZAbstractRODataset.FreeRecordBuffer(var Buffer: PChar);
01405 begin
01406 RowAccessor.DisposeBuffer(PZRowBuffer(Buffer));
01407 end;
01408
01409 {**
01410 Fetch all records. Added by Patyi
01411 }
01412 procedure TZAbstractRODataset.FetchAll;
01413 begin
01414 Connection.ShowSQLHourGlass;
01415 FetchRows(0);
01416 if Active then
01417 UpdateCursorPos;
01418 Connection.HideSQLHourGlass;
01419 end;
01420
01421 {**
01422 Executes a DML SQL statement.
01423 }
01424 procedure TZAbstractRODataset.ExecSQL;
01425 begin
01426 CheckConnected;
01427 Connection.ShowSQLHourGlass;
01428 try
01429 if Active then Close;
01430
01431 CheckSQLQuery;
01432 CheckInactive;
01433
01434 if (Statement = nil) or (Statement.GetConnection.IsClosed) then
01435 Statement := CreateStatement(FSQL.Statements[0].SQL, Properties)
01436 else
01437 if (Assigned(Statement)) then
01438 Statement.ClearParameters;
01439
01440 SetStatementParams(Statement, FSQL.Statements[0].ParamNamesArray,
01441 FParams, FDataLink);
01442
01443 FRowsAffected := Statement.ExecuteUpdatePrepared;
01444 finally
01445 Connection.HideSQLHourGlass;
01446 end;
01447 end;
01448
01449 {**
01450 Performs an internal initialization of field defiitions.
01451 }
01452 procedure TZAbstractRODataset.InternalInitFieldDefs;
01453 var
01454 I, J, Size: Integer;
01455 AutoInit: Boolean;
01456 FieldType: TFieldType;
01457 ResultSet: IZResultSet;
01458 FieldName: string;
01459 FName: string;
01460 begin
01461 FieldDefs.Clear;
01462 ResultSet := Self.ResultSet;
01463 AutoInit := ResultSet = nil;
01464
01465 try
01466 { Opens an internal result set if query is closed. }
01467 if AutoInit then
01468 begin
01469 CheckSQLQuery;
01470 CheckConnected;
01471 ResultSet := CreateResultSet(FSQL.Statements[0].SQL, 0);
01472 end;
01473 if not Assigned(ResultSet) then
01474 raise Exception.Create(SCanNotOpenResultSet);
01475
01476 { Reads metadata from resultset. }
01477
01478 with ResultSet.GetMetadata do
01479 begin
01480 if GetColumnCount > 0 then for I := 1 to GetColumnCount do
01481 begin
01482 FieldType := ConvertDbcToDatasetType(GetColumnType(I));
01483
01484 if FieldType in [ftString, ftWidestring, ftBytes] then
01485 Size := GetPrecision(I)
01486 else Size := 0;
01487
01488 J := 0;
01489 FieldName := GetColumnLabel(I);
01490 FName := FieldName;
01491 while FieldDefs.IndexOf(FName) >= 0 do
01492 begin
01493 Inc(J);
01494 FName := Format('%s_%d', [FieldName, J]);
01495 end;
01496
01497 with TFieldDef.Create(FieldDefs, FName, FieldType,
01498 Size, False, I) do
01499 begin
01500 {$IFNDEF FPC}
01501 {$IFNDEF FOSNOMETA}
01502 Required := IsWritable(I) and (IsNullable(I) = ntNoNulls);
01503 {$ENDIF}
01504 {$ENDIF}
01505 {$IFNDEF FOSNOMETA}
01506 if IsReadOnly(I) then Attributes := Attributes + [faReadonly];
01507 Precision := GetPrecision(I);
01508 {$ENDIF}
01509 DisplayName := FName;
01510 end;
01511 end;
01512 end;
01513
01514 finally
01515 { Closes localy opened resultset. }
01516 if AutoInit then
01517 begin
01518 if ResultSet <> nil then
01519 begin
01520 ResultSet.Close;
01521 ResultSet := nil;
01522 end;
01523 if Statement <> nil then
01524 begin
01525 Statement.Close;
01526 Statement := nil;
01527 end;
01528 end;
01529 end;
01530 end;
01531
01532 {**
01533 Creates a DBC statement for the query.
01534 @param SQL an SQL query.
01535 @param Properties a statement specific properties.
01536 @returns a created DBC statement.
01537 }
01538 function TZAbstractRODataset.CreateStatement(const SQL: string; Properties: TStrings):
01539 IZPreparedStatement;
01540 var
01541 Temp: TStrings;
01542 begin
01543 Temp := TStringList.Create;
01544 try
01545 if Assigned(Properties) then
01546 Temp.AddStrings(Properties);
01547 { Define TDataset specific parameters. }
01548 if doCalcDefaults in FOptions then
01549 Temp.Values['defaults'] := 'true'
01550 else Temp.Values['defaults'] := 'false';
01551
01552 Result := FConnection.DbcConnection.PrepareStatementWithParams(SQL, Temp);
01553 finally
01554 Temp.Free;
01555 end;
01556 end;
01557
01558 {**
01559 Creates a DBC resultset for the query.
01560 @param SQL an SQL query.
01561 @param MaxRows a maximum rows number (-1 for all).
01562 @returns a created DBC resultset.
01563 }
01564 function TZAbstractRODataset.CreateResultSet(const SQL: string;
01565 MaxRows: Integer): IZResultSet;
01566 begin
01567 Connection.ShowSQLHourGlass;
01568 try
01569 if not Assigned(Statement) then
01570 Statement := CreateStatement(FSQL.Statements[0].SQL, Properties)
01571 else
01572 Statement.ClearParameters;
01573 SetStatementParams(Statement, FSQL.Statements[0].ParamNamesArray,
01574 FParams, FDataLink);
01575 if RequestLive then
01576 Statement.SetResultSetConcurrency(rcUpdatable)
01577 else Statement.SetResultSetConcurrency(rcReadOnly);
01578 Statement.SetFetchDirection(fdForward);
01579 if IsUniDirectional then
01580 Statement.SetResultSetType(rtForwardOnly)
01581 else Statement.SetResultSetType(rtScrollInsensitive);
01582 if MaxRows > 0 then
01583 Statement.SetMaxRows(MaxRows);
01584
01585 if doSmartOpen in FOptions then
01586 begin
01587 if Statement.ExecutePrepared then
01588 Result := Statement.GetResultSet
01589 else Result := nil;
01590 end else
01591 Result := Statement.ExecuteQueryPrepared;
01592 finally
01593 Connection.HideSQLHourGlass;
01594 end;
01595 end;
01596
01597 {**
01598 Performs internal query opening.
01599 }
01600 procedure TZAbstractRODataset.InternalOpen;
01601 var
01602 ColumnList: TObjectList;
01603 begin
01604 CheckSQLQuery;
01605 CheckConnected;
01606
01607 CurrentRow := 0;
01608 FetchCount := 0;
01609 CurrentRows.Clear;
01610
01611 Connection.ShowSQLHourGlass;
01612 try
01613 { Creates an SQL statement and resultsets }
01614 if FSQL.StatementCount> 0 then
01615 ResultSet := CreateResultSet(FSQL.Statements[0].SQL, -1)
01616 else
01617 ResultSet := CreateResultSet('', -1);
01618 if not Assigned(ResultSet) then
01619 begin
01620 if not (doSmartOpen in FOptions) then
01621 raise Exception.Create(SCanNotOpenResultSet)
01622 else Exit;
01623 end;
01624
01625 { Initializes field and index defs. }
01626 if not FRefreshInProgress then
01627 InternalInitFieldDefs;
01628
01629 if DefaultFields and not FRefreshInProgress then
01630 CreateFields;
01631 BindFields(True);
01632
01633 { Initializes accessors and buffers. }
01634 ColumnList := ConvertFieldsToColumnInfo(Fields);
01635 try
01636 RowAccessor := TZRowAccessor.Create(ColumnList);
01637 finally
01638 ColumnList.Free;
01639 end;
01640 FOldRowBuffer := PZRowBuffer(AllocRecordBuffer);
01641 FNewRowBuffer := PZRowBuffer(AllocRecordBuffer);
01642
01643 FieldsLookupTable := CreateFieldsLookupTable(Fields);
01644 InitFilterFields := False;
01645
01646 IndexFields.Clear;
01647 GetFieldList(IndexFields, FLinkedFields); {renamed by bangfauzan}
01648
01649 { Performs sorting. }
01650 if FSortedFields <> '' then
01651 InternalSort;
01652 finally
01653 Connection.HideSQLHourGlass;
01654 end;
01655 end;
01656
01657 {**
01658 Performs internal query closing.
01659 }
01660 procedure TZAbstractRODataset.InternalClose;
01661 begin
01662 if ResultSet <> nil then
01663 ResultSet.Close;
01664 ResultSet := nil;
01665 if Statement <> nil then
01666 Statement.Close;
01667 Statement := nil;
01668
01669 if FOldRowBuffer <> nil then
01670 FreeRecordBuffer(PChar(FOldRowBuffer));
01671 FOldRowBuffer := nil;
01672 if FNewRowBuffer <> nil then
01673 FreeRecordBuffer(PChar(FNewRowBuffer));
01674 FNewRowBuffer := nil;
01675
01676 if RowAccessor <> nil then
01677 RowAccessor.Free;
01678 RowAccessor := nil;
01679
01680 { Destroy default fields }
01681 if DefaultFields and not FRefreshInProgress then
01682 DestroyFields;
01683
01684 CurrentRows.Clear;
01685 FieldsLookupTable := nil;
01686 end;
01687
01688 {**
01689 Performs internal go to first record.
01690 }
01691 procedure TZAbstractRODataset.InternalFirst;
01692 begin
01693 if CurrentRow > 0 then
01694 CheckBiDirectional;
01695 CurrentRow := 0;
01696 end;
01697
01698 {**
01699 Performs internal go to last record.
01700 }
01701 procedure TZAbstractRODataset.InternalLast;
01702 begin
01703 FetchRows(0);
01704 if CurrentRows.Count > 0 then
01705 CurrentRow := CurrentRows.Count + 1
01706 else CurrentRow := 0;
01707 end;
01708
01709 {**
01710 Processes internal exception handling.
01711 }
01712 procedure TZAbstractRODataset.InternalHandleException;
01713 begin
01714
01715 end;
01716
01717 {**
01718 Gets the maximum records count.
01719 @return the maximum records count.
01720 }
01721 function TZAbstractRODataset.GetRecordCount: LongInt;
01722 begin
01723 CheckActive;
01724 if not IsUniDirectional then
01725 FetchRows(FFetchRow);
01726 Result := CurrentRows.Count;
01727 end;
01728
01729 {**
01730 Gets the current record number.
01731 @return the current record number.
01732 }
01733 function TZAbstractRODataset.GetRecNo: Longint;
01734 begin
01735 if Active then
01736 UpdateCursorPos;
01737 Result := CurrentRow;
01738 end;
01739
01740 {**
01741 Moves current record to the specified record.
01742 @param Value a new current record number.
01743 }
01744 procedure TZAbstractRODataset.MoveRecNo(Value: Integer);
01745 var
01746 PreviousCurrentRow: Integer;
01747 begin
01748 Value := Max(1, Value);
01749 if Value < CurrentRow then
01750 CheckBiDirectional;
01751
01752 if FetchRows(Value) then
01753 CurrentRow := Value
01754 else CurrentRow := CurrentRows.Count;
01755
01756 PreviousCurrentRow := CurrentRow;
01757 try
01758 if not (State in [dsInactive]) then Resync([]);
01759 finally
01760 CurrentRow := PreviousCurrentRow;
01761 end;
01762 UpdateCursorPos;
01763 end;
01764
01765 {**
01766 Sets a new currenct record number.
01767 @param Value a new current record number.
01768 }
01769 procedure TZAbstractRODataset.SetRecNo(Value: Integer);
01770 begin
01771 CheckOpened;
01772 Value := Max(1, Value);
01773 if Value < CurrentRow then
01774 CheckBiDirectional;
01775
01776 DoBeforeScroll;
01777 MoveRecNo(Value);
01778 DoAfterScroll;
01779 end;
01780
01781 {**
01782 Defines is the query editable?
01783 @return <code>True</code> if the query is editable.
01784 }
01785 function TZAbstractRODataset.GetCanModify: Boolean;
01786 begin
01787 Result := RequestLive;
01788 end;
01789
01790 {**
01791 Gets a linked datasource.
01792 @returns a linked datasource.
01793 }
01794 function TZAbstractRODataset.GetDataSource: TDataSource;
01795 begin
01796 Result := DataLink.DataSource;
01797 end;
01798
01799 {**
01800 Sets a new linked datasource.
01801 @param Value a new linked datasource.
01802 }
01803 procedure TZAbstractRODataset.SetDataSource(Value: TDataSource);
01804 begin
01805 {$IFNDEF FPC}
01806 if IsLinkedTo(Value) then
01807 {$ELSE}
01808 if Value.IsLinkedTo(Self) then
01809 {$ENDIF}
01810 raise EZDatabaseError.Create(SCircularLink);
01811 DataLink.DataSource := Value;
01812 end;
01813
01814 {**
01815 Gets a master datasource.
01816 @returns a master datasource.
01817 }
01818 function TZAbstractRODataset.GetMasterDataSource: TDataSource;
01819 begin
01820 Result := MasterLink.DataSource;
01821 end;
01822
01823 {**
01824 Sets a new master datasource.
01825 @param Value a new master datasource.
01826 }
01827 procedure TZAbstractRODataset.SetMasterDataSource(Value: TDataSource);
01828 begin
01829 {$IFNDEF FPC}
01830 if IsLinkedTo(Value) then
01831 {$ELSE}
01832 if Value.IsLinkedTo(Self) then
01833 {$ENDIF}
01834 raise EZDatabaseError.Create(SCircularLink);
01835 MasterLink.DataSource := Value;
01836 RereadRows;
01837 end;
01838
01839 {**
01840 Gets master link fields.
01841 @returns a list with master fields.
01842 }
01843 function TZAbstractRODataset.GetMasterFields: string;
01844 begin
01845 Result := FMasterLink.FieldNames;
01846 end;
01847
01848 {**
01849 Sets master link fields.
01850 @param Value a new master link fields.
01851 }
01852 procedure TZAbstractRODataset.SetMasterFields(const Value: string);
01853 begin
01854 if FMasterLink.FieldNames <> Value then
01855 begin
01856 FMasterLink.FieldNames := Value;
01857 RereadRows;
01858 end;
01859 end;
01860
01861 {**
01862 Processes change events from the master dataset.
01863 @param Sender an event sender object.
01864 }
01865 procedure TZAbstractRODataset.MasterChanged(Sender: TObject);
01866 begin
01867 CheckBrowseMode;
01868 if (doAlwaysDetailResync in FOptions) or (FMasterLink.DataSet = nil)
01869 or not (FMasterLink.DataSet.State in [dsEdit, dsInsert]) then
01870 RereadRows;
01871 end;
01872
01873 {**
01874 Processes disable events from the master dataset.
01875 @param Sender an event sender object.
01876 }
01877 procedure TZAbstractRODataset.MasterDisabled(Sender: TObject);
01878 begin
01879 RereadRows;
01880 end;
01881
01882 {**
01883 Initializes new record with master fields.
01884 }
01885 procedure TZAbstractRODataset.DoOnNewRecord;
01886 var
01887 I: Integer;
01888 MasterField, DetailField: TField;
01889 Temp: Int64;
01890 begin
01891 if MasterLink.Active and (MasterLink.Fields.Count > 0) then
01892 begin
01893 for I := 0 to MasterLink.Fields.Count - 1 do
01894 begin
01895 if I < IndexFields.Count then
01896 begin
01897 MasterField := TField(MasterLink.Fields[I]);
01898 DetailField := TField(IndexFields[I]);
01899
01900 if (MasterField is TLargeIntField)
01901 or (DetailField is TLargeIntField) then
01902 begin
01903 if MasterField is TLargeIntField then
01904 Temp := TLargeIntField(
01905 MasterField).{$IFNDEF FPC}AsLargeInt{$ELSE}Value{$ENDIF}
01906 else Temp := MasterField.AsInteger;
01907 if DetailField is TLargeIntField then
01908 TLargeIntField(
01909 DetailField).{$IFNDEF FPC}AsLargeInt{$ELSE}Value{$ENDIF} := Temp
01910 else DetailField.AsString := IntToStr(Temp);
01911 end
01912
01913 else
01914 DetailField.Value := MasterField.Value;
01915 end;
01916 end;
01917 end;
01918 inherited DoOnNewRecord;
01919 end;
01920
01921 {**
01922 Gets a list of index field names.
01923 @returns a list of index field names.
01924 }
01925 function TZAbstractRODataset.GetLinkedFields: string; {renamed by bangfauzan}
01926 begin
01927 Result := FLinkedFields; {renamed by bangfauzan}
01928 end;
01929
01930 {**
01931 Sets a new list of index field names.
01932 @param Value a new list of index field names.
01933 }
01934 procedure TZAbstractRODataset.SetLinkedFields(const Value: string); {renamed by bangfauzan}
01935 begin
01936 if FLinkedFields <> Value then {renamed by bangfauzan}
01937 begin
01938 FLinkedFields := Value; {renamed by bangfauzan}
01939 IndexFields.Clear;
01940 if State <> dsInactive then
01941 begin
01942 GetFieldList(IndexFields, FLinkedFields); {renamed by bangfauzan}
01943 RereadRows;
01944 end;
01945 end;
01946 end;
01947
01948 {**
01949 Sets a new set of dataset options.
01950 @param Value a new set of dataset options.
01951 }
01952 procedure TZAbstractRODataset.SetOptions(Value: TZDatasetOptions);
01953 begin
01954 if FOptions <> Value then
01955 begin
01956 FOptions := Value;
01957 end;
01958 end;
01959
01960 {**
01961 Sets a new sorted fields.
01962 @param Value a new sorted fields.
01963 }
01964 procedure TZAbstractRODataset.SetSortedFields({const} Value: string); {bangfauzan modification}
01965 begin
01966 Value:=Trim(Value); {bangfauzan addition}
01967 if (FSortedFields <> Value) or (FIndexFieldNames <> Value)then {bangfauzan modification}
01968 begin
01969 FIndexFieldNames:=Value;
01970 FSortType := GetSortType; {bangfauzan addition}
01971 {removing ASC or DESC behind space}
01972 if (FSortType <> stIgnored) then begin {pawelsel modification}
01973 Value:=StringReplace(Value,' Desc','',[rfReplaceAll,rfIgnoreCase]);
01974 Value:=StringReplace(Value,' Asc','',[rfReplaceAll,rfIgnoreCase]);
01975 end;
01976 FSortedFields := Value;
01977 if Active then
01978 {InternalSort;}
01979 {bangfauzan modification}
01980 if (FSortedFields = '') then
01981 Self.InternalRefresh
01982 else
01983 InternalSort;
01984 {end of bangfauzan modification}
01985 end;
01986 end;
01987
01988 {**
01989 Refreshes parameters and reopens the dataset.
01990 }
01991 procedure TZAbstractRODataset.RefreshParams;
01992 var
01993 DataSet: TDataSet;
01994 begin
01995 DisableControls;
01996 try
01997 if FDataLink.DataSource <> nil then
01998 begin
01999 DataSet := FDataLink.DataSource.DataSet;
02000 if DataSet <> nil then
02001 if DataSet.Active and not (DataSet.State in [dsSetKey, dsEdit]) then
02002 begin
02003 Refresh;
02004 end;
02005 end;
02006 finally
02007 EnableControls;
02008 end;
02009 end;
02010
02011 {**
02012 Performs internal switch to the specified bookmark.
02013 @param Bookmark a specified bookmark.
02014 }
02015 procedure TZAbstractRODataset.InternalGotoBookmark(Bookmark: Pointer);
02016 var
02017 Index: Integer;
02018 begin
02019 Index := CurrentRows.IndexOf(PPointer(Bookmark)^);
02020
02021 if Index < 0 then
02022 raise EZDatabaseError.Create(SBookmarkWasNotFound);
02023 if Index < CurrentRow then
02024 CheckBiDirectional;
02025
02026 CurrentRow := Index + 1;
02027 end;
02028
02029 {**
02030 Performs an internal switch to the specified record.
02031 @param Buffer the specified row buffer.
02032 }
02033 procedure TZAbstractRODataset.InternalSetToRecord(Buffer: PChar);
02034 begin
02035 InternalGotoBookmark(@PZRowBuffer(Buffer)^.Index);
02036 end;
02037
02038 {**
02039 Performs an internal adding a new record.
02040 @param Buffer a buffer of the new adding record.
02041 @param Append <code>True</code> if record should be added to the end
02042 of the result set.
02043 }
02044 procedure TZAbstractRODataset.InternalAddRecord(Buffer: Pointer;
02045 Append: Boolean);
02046 begin
02047 RaiseReadOnlyError;
02048 end;
02049
02050 {**
02051 Performs an internal record removing.
02052 }
02053 procedure TZAbstractRODataset.InternalDelete;
02054 begin
02055 RaiseReadOnlyError;
02056 end;
02057
02058 {**
02059 Performs an internal post updates.
02060 }
02061 procedure TZAbstractRODataset.InternalPost;
02062 Procedure Checkrequired;
02063
02064 Var I : longint;
02065 columnindex : integer;
02066
02067 begin
02068 For I:=0 to Fields.Count-1 do
02069 With Fields[i] do
02070 Case State of
02071 dsEdit:
02072 if Required and not ReadOnly and (FieldKind=fkData) and IsNull then
02073 raise EZDatabaseError.Create(Format(SNeedField,[DisplayName]));
02074 dsInsert:
02075 if Required and not ReadOnly and (FieldKind=fkData) and IsNull then
02076 begin
02077
02078 columnindex := Resultset.FindColumn(Fields[i].FieldName);
02079 if (Columnindex = 0) or
02080 (not Resultset.GetMetadata.HasDefaultValue(columnIndex) and
02081 not Resultset.GetMetadata.IsAutoIncrement(columnIndex)) then
02082 raise EZDatabaseError.Create(Format(SNeedField,[DisplayName]));
02083 end;
02084 End;
02085 end;
02086
02087 begin
02088 if not (Self is TZAbstractDataset) then
02089 RaiseReadOnlyError;
02090
02091 {$IFNDEF VER130BELOW}
02092
02093
02094
02095
02096
02097 Checkrequired;
02098 {$ELSE}
02099 {$IFDEF FPC}
02100 Checkrequired;
02101 {$ENDIF}
02102 {$ENDIF}
02103 end;
02104
02105 {**
02106 Gets a bookmark flag from the specified record.
02107 @param Buffer a pointer to the record buffer.
02108 @return a bookmark flag from the specified record.
02109 }
02110 function TZAbstractRODataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
02111 begin
02112 Result := TBookmarkFlag(PZRowBuffer(Buffer)^.BookmarkFlag);
02113 end;
02114
02115 {**
02116 Sets a new bookmark flag to the specified record.
02117 @param Buffer a pointer to the record buffer.
02118 @param Value a new bookmark flag to the specified record.
02119 }
02120 procedure TZAbstractRODataset.SetBookmarkFlag(Buffer: PChar;
02121 Value: TBookmarkFlag);
02122 begin
02123 PZRowBuffer(Buffer)^.BookmarkFlag := Ord(Value);
02124 end;
02125
02126 {**
02127 Gets bookmark value from the specified record.
02128 @param Buffer a pointer to the record buffer.
02129 @param Data a pointer to the bookmark value.
02130 }
02131 procedure TZAbstractRODataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
02132 begin
02133 PInteger(Data)^ := PZRowBuffer(Buffer)^.Index;
02134 end;
02135
02136 {**
02137 Sets a new bookmark value from the specified record.
02138 @param Buffer a pointer to the record buffer.
02139 @param Data a pointer to the bookmark value.
02140 }
02141 procedure TZAbstractRODataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
02142 begin
02143 PZRowBuffer(Buffer)^.Index := PInteger(Data)^;
02144 end;
02145
02146 {**
02147 Compare two specified bookmarks.
02148 @param Bookmark1 the first bookmark object.
02149 @param Bookmark2 the second bookmark object.
02150 @return 0 if bookmarks are equal, -1 if the first bookmark is less,
02151 1 if the first bookmark is greatter.
02152 }
02153 function TZAbstractRODataset.CompareBookmarks(Bookmark1,
02154 Bookmark2: TBookmark): Integer;
02155 var
02156 Index1, Index2: Integer;
02157 begin
02158 Result := 0;
02159 if not Assigned(Bookmark1) or not Assigned(Bookmark2) then
02160 Exit;
02161 Index1 := CurrentRows.IndexOf(PPointer(Bookmark1)^);
02162 Index2 := CurrentRows.IndexOf(PPointer(Bookmark2)^);
02163 if Index1 < Index2 then Result := -1
02164 else if Index1 > Index2 then Result := 1;
02165 end;
02166
02167 {**
02168 Checks is the specified bookmark valid.
02169 @param Bookmark a bookmark object.
02170 @return <code>True</code> if the bookmark is valid.
02171 }
02172 function TZAbstractRODataset.BookmarkValid(Bookmark: TBookmark): Boolean;
02173 var
02174 Index: Integer;
02175 begin
02176 Result := False;
02177 if Active and Assigned(Bookmark) and (FResultSet <> nil) then
02178 try
02179 Index := CurrentRows.IndexOf(PPointer(Bookmark)^);
02180 Result := Index >= 0;
02181 except
02182 Result := False;
02183 end;
02184 end;
02185
02186 {**
02187 Performs an internal initialization of record buffer.
02188 @param Buffer a record buffer for initialization.
02189 }
02190 procedure TZAbstractRODataset.InternalInitRecord(Buffer: PChar);
02191 begin
02192 RowAccessor.ClearBuffer(PZRowBuffer(Buffer));
02193 end;
02194
02195 {**
02196 Performs an internal refreshing.
02197 }
02198 procedure TZAbstractRODataset.InternalRefresh;
02199 var
02200 RowNo: Integer;
02201 Found: Boolean;
02202 KeyFields: string;
02203 Temp: TZVariantDynArray;
02204 KeyValues: Variant;
02205 FieldRefs: TObjectDynArray;
02206 OnlyDataFields: Boolean;
02207 begin
02208 OnlyDataFields := False;
02209 FieldRefs := nil;
02210 if Active then
02211 begin
02212 if CurrentRow > 0 then
02213 begin
02214 RowNo := Integer(CurrentRows[CurrentRow - 1]);
02215 if ResultSet.GetRow <> RowNo then
02216 ResultSet.MoveAbsolute(RowNo);
02217
02218 if Properties.Values['KeyFields'] <> '' then
02219 KeyFields := Properties.Values['KeyFields']
02220 else
02221 KeyFields := DefineKeyFields(Fields);
02222 FieldRefs := DefineFields(Self, KeyFields, OnlyDataFields);
02223 SetLength(Temp, Length(FieldRefs));
02224 RetrieveDataFieldsFromResultSet(FieldRefs, ResultSet, Temp);
02225 if Length(FieldRefs) = 1 then
02226 KeyValues := EncodeVariant(Temp[0])
02227 else KeyValues := EncodeVariantArray(Temp);
02228 end
02229 else
02230 begin
02231 KeyFields := '';
02232 KeyValues := Unassigned;
02233 end;
02234
02235 DisableControls;
02236 try
02237 try
02238 FRefreshInProgress := True;
02239 InternalClose;
02240 InternalOpen;
02241 finally
02242 FRefreshInProgress := False;
02243 end;
02244
02245 DoBeforeScroll;
02246 if KeyFields <> '' then
02247 Found := Locate(KeyFields, KeyValues, [])
02248 else Found := False;
02249 finally
02250 EnableControls;
02251 end;
02252
02253 if not Found then
02254 begin
02255 DoBeforeScroll;
02256 DoAfterScroll;
02257 end;
02258 end;
02259 end;
02260
02261 {**
02262 Finds the next record in a filtered query.
02263 @param Restart a <code>True</code> to find from the start of the query.
02264 @param GoForward <code>True</code> to navigate in the forward direction.
02265 @return <code>True</code> if a sutisfied row was found.
02266 }
02267 function TZAbstractRODataset.FindRecord(Restart, GoForward: Boolean): Boolean;
02268 var
02269 Index: Integer;
02270 SavedFilterEnabled: Boolean;
02271 begin
02272 { Checks the current state. }
02273 CheckBrowseMode;
02274 DoBeforeScroll;
02275 Result := False;
02276
02277 { Defines an initial position position. }
02278 if Restart then
02279 begin
02280 if GoForward then
02281 Index := 1
02282 else
02283 begin
02284 FetchRows(0);
02285 Index := CurrentRows.Count;
02286 end
02287 end
02288 else
02289 begin
02290 Index := CurrentRow;
02291 if GoForward then
02292 begin
02293 Inc(Index);
02294 if Index > CurrentRows.Count then
02295 FetchOneRow;
02296 end else
02297 Dec(Index);
02298 end;
02299
02300 { Finds a record. }
02301 SavedFilterEnabled := FilterEnabled;
02302 try
02303 FilterEnabled := True;
02304 while (Index >= 1) and (Index <= CurrentRows.Count) do
02305 begin
02306 if FilterRow(Index) then
02307 begin
02308 Result := True;
02309 Break;
02310 end;
02311 if GoForward then
02312 begin
02313 Inc(Index);
02314 if Index > CurrentRows.Count then
02315 FetchOneRow;
02316 end else
02317 Dec(Index)
02318 end
02319 finally
02320 FilterEnabled := SavedFilterEnabled;
02321 end;
02322
02323 { Sets a new found position. }
02324 SetFound(Result);
02325 if Result then
02326 begin
02327 MoveRecNo(Index);
02328 DoAfterScroll;
02329 end;
02330 end;
02331
02332 {**
02333 Sets a filtering control flag.
02334 @param Value <code>True</code> to turn filtering On.
02335 }
02336 procedure TZAbstractRODataset.SetFiltered(Value: Boolean);
02337 begin
02338 if Value <> FilterEnabled then
02339 begin
02340 FilterEnabled := Value;
02341 inherited SetFiltered(Value);
02342 RereadRows;
02343 end;
02344 end;
02345
02346 {**
02347 Sets a new filter expression string.
02348 @param Value a new filter expression.
02349 }
02350 procedure TZAbstractRODataset.SetFilterText(const Value: string);
02351 begin
02352 inherited SetFilterText(Value);
02353 FilterExpression.DefaultVariables.Clear;
02354 FilterExpression.Expression := Value;
02355 InitFilterFields := False;
02356 if FilterEnabled then
02357 RereadRows;
02358 end;
02359
02360 {**
02361 Checks is the opened resultset sequensed?
02362 @return <code>True</code> if the opened resultset is sequenced.
02363 }
02364 function TZAbstractRODataset.IsSequenced: Boolean;
02365 begin
02366 Result := (not FilterEnabled);
02367 end;
02368
02369 {**
02370 Processes component notifications.
02371 @param AComponent a changed component object.
02372 @param Operation a component operation code.
02373 }
02374 procedure TZAbstractRODataset.Notification(AComponent: TComponent;
02375 Operation: TOperation);
02376 begin
02377 inherited Notification(AComponent, Operation);
02378
02379 if (Operation = opRemove) and (AComponent = FConnection) then
02380 begin
02381 Close;
02382 FConnection := nil;
02383 end;
02384
02385 if (Operation = opRemove) and Assigned(FDataLink)
02386 and (AComponent = FDataLink.Datasource) then
02387 FDataLink.DataSource := nil;
02388
02389 if (Operation = opRemove) and Assigned(FMasterLink)
02390 and (AComponent = FMasterLink.Datasource) then
02391 begin
02392 FMasterLink.DataSource := nil;
02393 RereadRows;
02394 end;
02395 end;
02396
02397 {**
02398 Performs an internal record search.
02399 @param KeyFields a list of field names.
02400 @param KeyValues a list of field values.
02401 @param Options a search options.
02402 @return an index of found row or -1 if nothing was found.
02403 }
02404 function TZAbstractRODataset.InternalLocate(const KeyFields: string;
02405 const KeyValues: Variant; Options: TLocateOptions): LongInt;
02406 var
02407 I, RowNo, RowCount: Integer;
02408 FieldRefs: TObjectDynArray;
02409 FieldIndices: TIntegerDynArray;
02410 OnlyDataFields: Boolean;
02411 SearchRowBuffer: PZRowBuffer;
02412 DecodedKeyValues: TZVariantDynArray;
02413 RowValues: TZVariantDynArray;
02414 PartialKey: Boolean;
02415 CaseInsensitive: Boolean;
02416 begin
02417 OnlyDataFields := False;
02418 CheckBrowseMode;
02419 Result := -1;
02420 DecodedKeyValues := nil;
02421
02422 PartialKey := loPartialKey in Options;
02423 CaseInsensitive := loCaseInsensitive in Options;
02424
02425 FieldRefs := DefineFields(Self, KeyFields, OnlyDataFields);
02426 FieldIndices := nil;
02427 if FieldRefs = nil then Exit;
02428 DecodedKeyValues := DecodeVariantArray(KeyValues);
02429
02430 { Checks for equal field and values number }
02431 if Length(FieldRefs) <> Length(DecodedKeyValues) then
02432 raise EZDatabaseError.Create(SIncorrectSearchFieldsNumber);
02433 SetLength(RowValues, Length(DecodedKeyValues));
02434
02435 if not OnlyDataFields then
02436 begin
02437 { Processes fields if come calculated or lookup fields are involved. }
02438 SearchRowBuffer := PZRowBuffer(AllocRecordBuffer);
02439 try
02440 I := 0;
02441 FieldIndices := DefineFieldIndices(FieldsLookupTable, FieldRefs);
02442 RowCount := CurrentRows.Count;
02443 while True do
02444 begin
02445 while (I >= RowCount) and FetchOneRow do
02446 RowCount := CurrentRows.Count;
02447 if I >= RowCount then
02448 Break;
02449
02450 RowNo := Integer(CurrentRows[I]);
02451 ResultSet.MoveAbsolute(RowNo);
02452
02453 RowAccessor.RowBuffer := SearchRowBuffer;
02454 RowAccessor.RowBuffer^.Index := RowNo;
02455 FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
02456 GetCalcFields(PChar(SearchRowBuffer));
02457 RetrieveDataFieldsFromRowAccessor(
02458 FieldRefs, FieldIndices, RowAccessor, RowValues);
02459
02460 if CompareDataFields(DecodedKeyValues, RowValues,
02461 PartialKey, CaseInsensitive) then
02462 begin
02463 Result := I + 1;
02464 Break;
02465 end;
02466
02467 Inc(I);
02468 end;
02469 finally
02470 if SearchRowBuffer <> nil then
02471 FreeRecordBuffer(PChar(SearchRowBuffer));
02472 end;
02473 end
02474 else
02475 begin
02476 PrepareValuesForComparison(FieldRefs, DecodedKeyValues,
02477 ResultSet, PartialKey, CaseInsensitive);
02478
02479 { Processes only data fields. }
02480 I := 0;
02481 RowCount := CurrentRows.Count;
02482 while True do
02483 begin
02484 while (I >= RowCount) and FetchOneRow do
02485 RowCount := CurrentRows.Count;
02486 if I >= RowCount then
02487 Break;
02488
02489 RowNo := Integer(CurrentRows[I]);
02490 ResultSet.MoveAbsolute(RowNo);
02491
02492 if CompareFieldsFromResultSet(FieldRefs, DecodedKeyValues,
02493 ResultSet, PartialKey, CaseInsensitive) then
02494 begin
02495 Result := I + 1;
02496 Break;
02497 end;
02498
02499 Inc(I);
02500 end;
02501 end;
02502 end;
02503
02504 {**
02505 Locates an interested record by specified search criteria.
02506 @param KeyFields a list of field names.
02507 @param KeyValues a list of field values.
02508 @param Options a search options.
02509 @return <code>True</code> if record was found or <code>False</code> otherwise.
02510 }
02511 function TZAbstractRODataset.Locate(const KeyFields: string;
02512 const KeyValues: Variant; Options: TLocateOptions): Boolean;
02513 var
02514 Index: Integer;
02515 begin
02516 DoBeforeScroll;
02517 Index := InternalLocate(KeyFields, KeyValues, Options);
02518 if Index > 0 then
02519 begin
02520 MoveRecNo(Index);
02521 DoAfterScroll;
02522 Result := True;
02523 end else
02524 Result := False;
02525 SetFound(Result);
02526 end;
02527
02528 {**
02529 Lookups specified fields from the searched record.
02530 @param KeyValues a list of field names to search record.
02531 @param KeyValues an array of field values to search record.
02532 @param ResultFields a list of field names to return as a result.
02533 @return an array of requested field values.
02534 }
02535 function TZAbstractRODataset.Lookup(const KeyFields: string;
02536 const KeyValues: Variant; const ResultFields: string): Variant;
02537 var
02538 RowNo: Integer;
02539 FieldRefs: TObjectDynArray;
02540 FieldIndices: TIntegerDynArray;
02541 OnlyDataFields: Boolean;
02542 SearchRowBuffer: PZRowBuffer;
02543 ResultValues: TZVariantDynArray;
02544 begin
02545 OnlyDataFields := False;
02546 Result := Null;
02547 RowNo := InternalLocate(KeyFields, KeyValues, []);
02548 FieldRefs := nil;
02549 FieldIndices := nil;
02550 if RowNo < 0 then Exit;
02551
02552 { Fill result array }
02553 FieldRefs := DefineFields(Self, ResultFields, OnlyDataFields);
02554 FieldIndices := DefineFieldIndices(FieldsLookupTable, FieldRefs);
02555 SetLength(ResultValues, Length(FieldRefs));
02556 SearchRowBuffer := PZRowBuffer(AllocRecordBuffer);
02557 try
02558 RowNo := Integer(CurrentRows[RowNo - 1]);
02559 if ResultSet.GetRow <> RowNo then
02560 ResultSet.MoveAbsolute(RowNo);
02561
02562 RowAccessor.RowBuffer := SearchRowBuffer;
02563 RowAccessor.RowBuffer^.Index := RowNo;
02564 FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
02565 GetCalcFields(PChar(SearchRowBuffer));
02566 RetrieveDataFieldsFromRowAccessor(
02567 FieldRefs, FieldIndices, RowAccessor, ResultValues);
02568 finally
02569 FreeRecordBuffer(PChar(SearchRowBuffer));
02570 end;
02571
02572 if Length(FieldIndices) = 1 then
02573 Result := EncodeVariant(ResultValues[0])
02574 else Result := EncodeVariantArray(ResultValues);
02575 end;
02576
02577 {**
02578 Gets the updated status for the current row.
02579 @return the UpdateStatus value for the current row.
02580 }
02581 function TZAbstractRODataset.UpdateStatus: TUpdateStatus;
02582 var
02583 RowNo: Integer;
02584 begin
02585 Result := usUnmodified;
02586 if (ResultSet <> nil) and (CurrentRows.Count > 0) then
02587 begin
02588 RowNo := Integer(CurrentRows[CurrentRow - 1]);
02589 if ResultSet.GetRow <> RowNo then
02590 ResultSet.MoveAbsolute(RowNo);
02591
02592 if ResultSet.RowInserted then
02593 Result := usInserted
02594 else if ResultSet.RowUpdated then
02595 Result := usModified
02596 else if ResultSet.RowDeleted then
02597 Result := usDeleted;
02598 end;
02599 end;
02600
02601 {**
02602 Translates strings between ansi and oem character sets.
02603 }
02604 function TZAbstractRODataset.Translate(Src, Dest: PChar; ToOem: Boolean): Integer;
02605 begin
02606 if (Src <> nil) then
02607 begin
02608 Result := StrLen(Src);
02609 {$IFNDEF UNIX}
02610 if doOemTranslate in FOptions then
02611 begin
02612 if ToOem then
02613 CharToOem(Src, Dest)
02614 else OemToChar(Src, Dest);
02615 Dest[Result] := #0;
02616 end
02617 else
02618 {$ENDIF}
02619 begin
02620 if (Src <> Dest) then
02621 StrCopy(Dest, Src);
02622 end;
02623 end else
02624 Result := 0;
02625 end;
02626
02627 {**
02628 Creates a stream object for specified blob field.
02629 @param Field an interested field object.
02630 @param Mode a blob open mode.
02631 @return a created stream object.
02632 }
02633 function TZAbstractRODataset.CreateBlobStream(Field: TField;
02634 Mode: TBlobStreamMode): TStream;
02635 var
02636 ColumnIndex: Integer;
02637 RowBuffer: PZRowBuffer;
02638 Blob: IZBlob;
02639 WasNull: Boolean;
02640 begin
02641 WasNull := False;
02642 CheckActive;
02643
02644 Result := nil;
02645 if (Field.DataType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo])
02646 and GetActiveBuffer(RowBuffer) then
02647 begin
02648 ColumnIndex := DefineFieldIndex(FieldsLookupTable, Field);
02649 RowAccessor.RowBuffer := RowBuffer;
02650
02651 if Mode = bmRead then
02652 begin
02653 if Field.DataType in [ftMemo, ftFmtMemo] then
02654 Result := RowAccessor.GetAsciiStream(ColumnIndex, WasNull)
02655 else Result := RowAccessor.GetBinaryStream(ColumnIndex, WasNull);
02656 end
02657 else
02658 begin
02659 Blob := RowAccessor.GetBlob(ColumnIndex, WasNull);
02660 if Blob <> nil then
02661 Blob := Blob.Clone;
02662 RowAccessor.SetBlob(ColumnIndex, Blob);
02663 Result := TZBlobStream.Create(Field as TBlobField, Blob, Mode);
02664 end;
02665 end;
02666 if Result = nil then
02667 Result := TMemoryStream.Create;
02668 end;
02669
02670 {**
02671 Closes the specified BLOB field.
02672 @param a BLOB field object.
02673 }
02674 procedure TZAbstractRODataset.CloseBlob(Field: TField);
02675 begin
02676 end;
02677
02678 {**
02679 Performs sorting of the internal rows.
02680 }
02681 procedure TZAbstractRODataset.InternalSort;
02682 var
02683 I, RowNo: Integer;
02684 SavedRowBuffer: PZRowBuffer;
02685 begin
02686 if FIndexFieldNames = '' then exit; {bangfauzan addition}
02687 if (ResultSet <> nil) and not IsUniDirectional then
02688 begin
02689 FIndexFieldNames := Trim(FIndexFieldNames); {bangfauzan modification}
02690 DefineSortedFields(Self, {FSortedFields} FIndexFieldNames {bangfauzan modification},
02691 FSortedFieldRefs, FSortedFieldDirs, FSortedOnlyDataFields);
02692
02693 if (CurrentRow <= CurrentRows.Count) and (CurrentRows.Count > 0)
02694 and (CurrentRow > 0) then
02695 RowNo := Integer(CurrentRows[CurrentRow - 1])
02696 else RowNo := -1;
02697
02698 { Restores the previous order. }
02699 if Length(FSortedFieldRefs) = 0 then
02700 begin
02701 CurrentRows.Sort(ClearSort);
02702 end
02703 else
02704 begin
02705 FetchRows(0);
02706 if FSortedOnlyDataFields then
02707 begin
02708 { Converts field objects into field indices. }
02709 SetLength(FSortedFieldIndices, Length(FSortedFieldRefs));
02710 for I := 0 to High(FSortedFieldRefs) do
02711 FSortedFieldIndices[I] := TField(FSortedFieldRefs[I]).FieldNo;
02712 { Performs a sorting. }
02713 CurrentRows.Sort(LowLevelSort);
02714 end
02715 else
02716 begin
02717 SavedRowBuffer := RowAccessor.RowBuffer;
02718 { Sorts using generic highlevel approach. }
02719 try
02720 { Allocates buffers for sorting. }
02721 RowAccessor.AllocBuffer(FSortRowBuffer1);
02722 RowAccessor.AllocBuffer(FSortRowBuffer2);
02723 { Converts field objects into field indices. }
02724 SetLength(FSortedFieldIndices, Length(FSortedFieldRefs));
02725 for I := 0 to High(FSortedFieldRefs) do
02726 begin
02727 FSortedFieldIndices[I] := DefineFieldIndex(FieldsLookupTable,
02728 TField(FSortedFieldRefs[I]));
02729 end;
02730 { Performs sorting. }
02731 CurrentRows.Sort(HighLevelSort);
02732 finally
02733 { Disposed buffers for sorting. }
02734 RowAccessor.DisposeBuffer(FSortRowBuffer1);
02735 RowAccessor.DisposeBuffer(FSortRowBuffer2);
02736 RowAccessor.RowBuffer := SavedRowBuffer;
02737 end;
02738 end;
02739 end;
02740
02741 CurrentRow := CurrentRows.IndexOf(Pointer(RowNo)) + 1;
02742 CurrentRow := Min(Max(0, CurrentRow), CurrentRows.Count);
02743 if not (State in [dsInactive]) then Resync([]);
02744 end;
02745 end;
02746
02747 {**
02748 Clears list sorting and restores the previous order.
02749 @param Item1 a reference to the first row.
02750 @param Item2 a reference to the second row.
02751 @returns >0 if Item1 > Item2, <0 it Item1 < Item2 and 0
02752 if Item1 and Item2 are equal.
02753 }
02754 function TZAbstractRODataset.ClearSort(Item1, Item2: Pointer): Integer;
02755 begin
02756 Result := Integer(Item1) - Integer(Item2);
02757 end;
02758
02759 {**
02760 Sorting list using generic approach which is slow but may be used
02761 with calculated fields.
02762
02763 @param Item1 a reference to the first row.
02764 @param Item2 a reference to the second row.
02765 @returns >0 if Item1 > Item2, <0 it Item1 < Item2 and 0
02766 if Item1 and Item2 are equal.
02767 }
02768 function TZAbstractRODataset.HighLevelSort(Item1, Item2: Pointer): Integer;
02769 var
02770 RowNo: Integer;
02771 begin
02772 { Gets the first row. }
02773 RowNo := Integer(Item1);
02774 ResultSet.MoveAbsolute(RowNo);
02775 RowAccessor.RowBuffer := FSortRowBuffer1;
02776 RowAccessor.RowBuffer^.Index := RowNo;
02777 FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
02778 FRowAccessor.RowBuffer^.BookmarkFlag := Ord(bfCurrent);
02779 GetCalcFields(PChar(FSortRowBuffer1));
02780
02781 { Gets the second row. }
02782 RowNo := Integer(Item2);
02783 ResultSet.MoveAbsolute(RowNo);
02784 RowAccessor.RowBuffer := FSortRowBuffer2;
02785 RowAccessor.RowBuffer^.Index := RowNo;
02786 FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
02787 FRowAccessor.RowBuffer^.BookmarkFlag := Ord(bfCurrent);
02788 GetCalcFields(PChar(FSortRowBuffer2));
02789
02790 { Compare both records. }
02791 Result := RowAccessor.CompareBuffers(FSortRowBuffer1, FSortRowBuffer2,
02792 FSortedFieldIndices, FSortedFieldDirs);
02793 end;
02794
02795 {**
02796 Sorting list using lowlevel approach which is fast but may not be used
02797 with calculated fields.
02798
02799 @param Item1 a reference to the first row.
02800 @param Item2 a reference to the second row.
02801 @returns >0 if Item1 > Item2, <0 it Item1 < Item2 and 0
02802 if Item1 and Item2 are equal.
02803 }
02804 function TZAbstractRODataset.LowLevelSort(Item1, Item2: Pointer): Integer;
02805 begin
02806 Result := ResultSet.CompareRows(Integer(Item1), Integer(Item2),
02807 FSortedFieldIndices, FSortedFieldDirs);
02808 end;
02809
02810 {**
02811 Sets a new dataset properties.
02812 @param Value a dataset properties.
02813 }
02814 procedure TZAbstractRODataset.SetProperties(const Value: TStrings);
02815 begin
02816 FProperties.Assign(Value);
02817 end;
02818
02819 {$IFDEF WITH_IPROVIDER}
02820
02821 {**
02822 Starts a new transaction.
02823 }
02824 procedure TZAbstractRODataset.PSStartTransaction;
02825 begin
02826 if Assigned(FConnection) and not FConnection.AutoCommit then
02827 begin
02828 if not FConnection.Connected then
02829 FConnection.Connect;
02830 FConnection.StartTransaction;
02831 end;
02832 end;
02833
02834 {**
02835 Completes previously started transaction.
02836 @param Commit a commit transaction flag.
02837 }
02838 procedure TZAbstractRODataset.PSEndTransaction(Commit: Boolean);
02839 begin
02840 if Assigned(FConnection) and FConnection.Connected
02841 and not FConnection.AutoCommit then
02842 begin
02843 if Commit then FConnection.Commit
02844 else FConnection.Rollback;
02845 end;
02846 end;
02847
02848 {**
02849 Checks if this query is in transaction mode.
02850 @returns <code>True</code> if query in transaction.
02851 }
02852 function TZAbstractRODataset.PSInTransaction: Boolean;
02853 begin
02854 Result := Assigned(FConnection) and FConnection.Connected
02855 and (FConnection.TransactIsolationLevel <> tiNone)
02856 and not FConnection.AutoCommit;
02857 end;
02858
02859 {**
02860 Returns a string quote character.
02861 @retuns a quote character.
02862 }
02863 {$IFDEF BDS4_UP}
02864 function TZAbstractRODataset.PSGetQuoteCharW: WideString;
02865 {$ELSE}
02866 function TZAbstractRODataset.PSGetQuoteChar: string;
02867 {$ENDIF}
02868 begin
02869 if Assigned(FConnection) then
02870 begin
02871 if not FConnection.Connected then
02872 FConnection.Connect;
02873 Result := FConnection.DbcConnection.GetMetadata.GetIdentifierQuoteString;
02874 if Length(Result) > 1 then
02875 Result := Copy(Result, 1, 1);
02876 end
02877 else
02878 Result := '"';
02879 end;
02880
02881 {**
02882 Checks if dataset can execute any commands?
02883 @returns <code>True</code> if the query can execute any commands.
02884 }
02885 function TZAbstractRODataset.PSIsSQLSupported: Boolean;
02886 begin
02887 Result := True;
02888 end;
02889
02890 {**
02891 Checks if dataset can execute SQL queries?
02892 @returns <code>True</code> if the query can execute SQL.
02893 }
02894 function TZAbstractRODataset.PSIsSQLBased: Boolean;
02895 begin
02896 Result := True;
02897 end;
02898
02899 {**
02900 Resets this dataset.
02901 }
02902 procedure TZAbstractRODataset.PSReset;
02903 begin
02904 inherited PSReset;
02905 if Active then
02906 begin
02907 Refresh;
02908 First;
02909 end;
02910 end;
02911
02912 {**
02913 Execute statement a SQL query.
02914 }
02915 procedure TZAbstractRODataset.PSExecute;
02916 begin
02917 ExecSQL;
02918 end;
02919
02920 {**
02921 Gets query parameters.
02922 @returns parameters of this query.
02923 }
02924 function TZAbstractRODataset.PSGetParams: TParams;
02925 begin
02926 Result := Params;
02927 end;
02928
02929 {**
02930 Set new query parameters
02931 @param AParams new parameters to set into this query.
02932 }
02933 procedure TZAbstractRODataset.PSSetParams(AParams: TParams);
02934 begin
02935 if AParams.Count > 0 then
02936 Params.Assign(AParams);
02937 end;
02938
02939 {**
02940 Sets a command text for this query to execute.
02941 @param CommandText a command text for this query.
02942 }
02943 procedure TZAbstractRODataset.PSSetCommandText(const CommandText: string);
02944 begin
02945 SQL.Text := CommandText;
02946 end;
02947
02948 {**
02949 Updates a record in the specified dataset.
02950 @param UpdateKind a type of the update.
02951 @param Delta a dataset with updates.
02952 }
02953 function TZAbstractRODataset.PSUpdateRecord(UpdateKind: TUpdateKind;
02954 Delta: TDataSet): Boolean;
02955 begin
02956 Result := False;
02957 end;
02958
02959 {**
02960 Generates an EUpdateError object based on another exception object.
02961 @param E occured exception.
02962 @param Prev a previous update error.
02963 @returns a new created update error.
02964 }
02965 function TZAbstractRODataset.PSGetUpdateException(E: Exception;
02966 Prev: EUpdateError): EUpdateError;
02967 var
02968 PrevErrorCode: Integer;
02969 begin
02970 if E is EZSQLException then
02971 begin
02972 if Assigned(Prev) then
02973 PrevErrorCode := Prev.ErrorCode
02974 else PrevErrorCode := 0;
02975
02976 Result := EUpdateError.Create(E.Message, '',
02977 EZSQLException(E).ErrorCode, PrevErrorCode, E);
02978 end
02979 else
02980 Result := EUpdateError.Create(E.Message, '', -1, -1, E);
02981 end;
02982
02983 {**
02984 Gets a table name if table is only one in the SELECT SQL statement.
02985 @returns a table name or an empty string is SQL query is complex SELECT
02986 or not SELECT statement.
02987 }
02988 {$IFDEF BDS4_UP}
02989 function TZAbstractRODataset.PSGetTableNameW: WideString;
02990 {$ELSE}
02991 function TZAbstractRODataset.PSGetTableName: string;
02992 {$ENDIF}
02993 var
02994 Driver: IZDriver;
02995 Tokenizer: IZTokenizer;
02996 StatementAnalyser: IZStatementAnalyser;
02997 SelectSchema: IZSelectSchema;
02998 begin
02999 Result := '';
03000 if FConnection <> nil then
03001 begin
03002 Driver := FConnection.DbcDriver;
03003 Tokenizer := Driver.GetTokenizer;
03004 StatementAnalyser := Driver.GetStatementAnalyser;
03005 SelectSchema := StatementAnalyser.DefineSelectSchemaFromQuery(
03006 Tokenizer, SQL.Text);
03007 if Assigned(SelectSchema) and (SelectSchema.TableCount = 1) then
03008 Result := SelectSchema.Tables[0].FullName;
03009 end;
03010 end;
03011
03012 {**
03013 Defines a list of query primary key fields.
03014 @returns a semicolon delimited list of query key fields.
03015 }
03016 {$IFDEF BDS4_UP}
03017 function TZAbstractRODataset.PSGetKeyFieldsW: WideString;
03018 begin
03019 Result := inherited PSGetKeyFieldsW;
03020 end;
03021 {$ELSE}
03022 function TZAbstractRODataset.PSGetKeyFields: string;
03023 begin
03024 Result := inherited PSGetKeyFields;
03025 end;
03026 {$ENDIF}
03027
03028 {**
03029 Executes a SQL statement with parameters.
03030 @param ASQL a SQL statement with parameters defined with question marks.
03031 @param AParams a collection of statement parameters.
03032 @param ResultSet a supplied result set reference (just ignored).
03033 @returns a number of updated rows.
03034 }
03035 function TZAbstractRODataset.PSExecuteStatement(const ASQL: string;
03036 AParams: TParams; ResultSet: Pointer): Integer;
03037 var
03038 I: Integer;
03039 Statement: IZPreparedStatement;
03040 ParamValue: TParam;
03041 Stream: TStream;
03042 begin
03043 if Assigned(FConnection) then
03044 begin
03045 if not FConnection.Connected then
03046 FConnection.Connect;
03047 Statement := FConnection.DbcConnection.PrepareStatement(ASQL);
03048 if (AParams <> nil) and (AParams.Count > 0) then
03049 begin
03050 for I := 0 to AParams.Count - 1 do
03051 begin
03052 ParamValue := AParams[I];
03053 if ParamValue.IsNull then
03054 Statement.SetNull(I + 1, ConvertDatasetToDbcType(ParamValue.DataType))
03055 else begin
03056 case ParamValue.DataType of
03057 ftBoolean:
03058 Statement.SetBoolean(I + 1, ParamValue.AsBoolean);
03059 ftSmallInt:
03060 Statement.SetShort(I + 1, ParamValue.AsSmallInt);
03061 ftInteger, ftAutoInc:
03062 Statement.SetInt(I + 1, ParamValue.AsInteger);
03063 ftFloat:
03064 Statement.SetDouble(I + 1, ParamValue.AsFloat);
03065 ftLargeInt:
03066 Statement.SetInt(I + 1, ParamValue.AsInteger);
03067 ftString:
03068 Statement.SetString(I + 1, ParamValue.AsString);
03069 ftBytes:
03070 Statement.SetString(I + 1, ParamValue.AsString);
03071 ftDate:
03072 Statement.SetDate(I + 1, ParamValue.AsDate);
03073 ftTime:
03074 Statement.SetTime(I + 1, ParamValue.AsTime);
03075 ftDateTime:
03076 Statement.SetTimestamp(I + 1, ParamValue.AsDateTime);
03077 ftMemo:
03078 begin
03079 Stream := TStringStream.Create(ParamValue.AsMemo);
03080 try
03081 Statement.SetAsciiStream(I + 1, Stream);
03082 finally
03083 Stream.Free;
03084 end;
03085 end;
03086 ftBlob, ftGraphic:
03087 begin
03088 Stream := TStringStream.Create(ParamValue.AsBlob);
03089 try
03090 Statement.SetBinaryStream(I + 1, Stream);
03091 finally
03092 Stream.Free;
03093 end;
03094 end;
03095 end;
03096 end;
03097 end;
03098 end;
03099 Result := Statement.ExecuteUpdatePrepared;
03100 end else
03101 Result := 0;
03102 end;
03103
03104 {$ENDIF}
03105
03106 procedure TZAbstractRODataset.CheckFieldCompatibility(Field: TField;FieldDef: TFieldDef);
03107
03108 {$IFDEF FPC}
03109 const
03110 BaseFieldTypes: array[TFieldType] of TFieldType = (
03111 ftUnknown, ftString, ftInteger, ftInteger, ftInteger, ftBoolean, ftFloat,
03112 ftFloat, ftBCD, ftDateTime, ftDateTime, ftDateTime, ftBytes, ftVarBytes,
03113 ftInteger, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftUnknown,
03114 ftString, ftString, ftLargeInt, ftADT, ftArray, ftReference, ftDataSet,
03115 ftBlob, ftBlob, ftVariant, ftInterface, ftInterface, ftString, ftTimeStamp, ftFMTBcd
03116 {$IFDEF FPC2_1UP}, ftString, ftBlob{$ENDIF});
03117
03118 {$ELSE}
03119 {$IFDEF VER180}
03120 const
03121 BaseFieldTypes: array[TFieldType] of TFieldType = (
03122 ftUnknown, ftString, ftInteger, ftInteger, ftInteger, ftBoolean, ftFloat,
03123 ftFloat, ftBCD, ftDateTime, ftDateTime, ftDateTime, ftBytes, ftVarBytes,
03124 ftInteger, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftUnknown,
03125 ftString, ftString, ftLargeInt, ftADT, ftArray, ftReference, ftDataSet,
03126 ftBlob, ftBlob, ftVariant, ftInterface, ftInterface, ftString, ftTimeStamp, ftFMTBcd,
03127 ftFixedWideChar,ftWideMemo,ftOraTimeStamp,ftOraInterval);
03128 {$ELSE}
03129 const
03130 BaseFieldTypes: array[TFieldType] of TFieldType = (
03131 ftUnknown, ftString, ftInteger, ftInteger, ftInteger, ftBoolean, ftFloat,
03132 ftFloat, ftBCD, ftDateTime, ftDateTime, ftDateTime, ftBytes, ftVarBytes,
03133 ftInteger, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftUnknown,
03134 ftString, ftString, ftLargeInt, ftADT, ftArray, ftReference, ftDataSet,
03135 ftBlob, ftBlob, ftVariant, ftInterface, ftInterface, ftString{$IFNDEF VER130}, ftTimestamp, ftFMTBcd{$ENDIF});
03136 {$ENDIF}
03137 {$ENDIF}
03138
03139 CheckTypeSizes = [ftBytes, ftVarBytes, ftBCD, ftReference];
03140
03141 begin
03142 with Field do
03143 begin
03144 if (BaseFieldTypes[DataType] <> BaseFieldTypes[FieldDef.DataType]) then
03145 DatabaseErrorFmt(SFieldTypeMismatch, [DisplayName,
03146 FieldTypeNames[DataType], FieldTypeNames[FieldDef.DataType]], Self);
03147 if (DataType in CheckTypeSizes) and (Size <> FieldDef.Size) then
03148 DatabaseErrorFmt(SFieldSizeMismatch, [DisplayName, Size,
03149 FieldDef.Size], Self);
03150 end;
03151 end;
03152
03153 {**
03154 Reset the calculated (includes fkLookup) fields
03155 @param Buffer
03156 }
03157 procedure TZAbstractRODataset.ClearCalcFields(Buffer: PChar);
03158 var
03159 Index: Integer;
03160 begin
03161 RowAccessor.RowBuffer := PZRowBuffer(Buffer);
03162 for Index := 1 to Fields.Count do
03163 if (Fields[Index-1].FieldKind in [fkCalculated, fkLookup]) then
03164 RowAccessor.SetNull(DefineFieldindex(FFieldsLookupTable,Fields[Index-1]));
03165 end;
03166
03167 {=======================bangfauzan addition========================}
03168 function TZAbstractRODataset.GetSortType: TSortType;
03169 var
03170 AscCount, DescCount: Integer;
03171 s: String;
03172 begin
03173 {pawelsel modification}
03174 AscCount:=0;
03175 DescCount:=0;
03176 s:=StringReplace(FIndexFieldNames,';',',',[rfReplaceAll]);
03177 while Pos(',',s)>0 do
03178 begin
03179 if Pos(' DESC',UpperCase(Copy(s,1,Pos(',',s))))>0 then
03180 Inc(DescCount)
03181 else
03182 Inc(AscCount);
03183 s:=Copy(s,Pos(',',s)+1,Length(s)-Pos(',',s));
03184 end;
03185 if Length(s)>0 then
03186 if Pos(' DESC',UpperCase(s))>0 then
03187 Inc(DescCount)
03188 else
03189 Inc(AscCount);
03190 if (DescCount > 0) and (AscCount > 0) then
03191 Result:=stIgnored
03192 else if (DescCount > 0) then
03193 Result:=stDescending
03194 else
03195 Result:=stAscending;
03196 end;
03197
03198 procedure TZAbstractRODataset.SetSortType(Value: TSortType);
03199 begin
03200 if FSortType <> Value then
03201 begin
03202 FSortType := Value;
03203 if (FSortType <> stIgnored) then begin {pawelsel modification}
03204 FSortedFields:=StringReplace(FSortedFields,' Desc','',[rfReplaceAll,rfIgnoreCase]);
03205 FSortedFields:=StringReplace(FSortedFields,' Asc','',[rfReplaceAll,rfIgnoreCase]);
03206 end;
03207 FIndexFieldNames:=GetIndexFieldNames;
03208 if Active then
03209 if (FSortedFields = '') then
03210 Self.InternalRefresh
03211 else
03212 InternalSort;
03213 end;
03214 end;
03215
03216 function TZAbstractRODataset.GetIndexFieldNames : String;
03217 begin
03218 Result:=FSortedFields;
03219 if Result<>'' then begin {pawelsel modification}
03220 if FSortType=stAscending then begin
03221 Result:=StringReplace(Result,';',' Asc;',[rfReplaceAll]);
03222 Result:=StringReplace(Result,',',' Asc,',[rfReplaceAll]);
03223 Result:=Result+' Asc';
03224 end;
03225 if FSortType=stDescending then begin
03226 Result:=StringReplace(Result,';',' Desc;',[rfReplaceAll]);
03227 Result:=StringReplace(Result,',',' Desc,',[rfReplaceAll]);
03228 Result:=Result+' Desc';
03229 end;
03230 end;
03231 end;
03232
03233 procedure TZAbstractRODataset.SetIndexFieldNames(Value: String);
03234 begin
03235 Value:=Trim(Value);
03236 {pawelsel modification}
03237 Value:=StringReplace(Value,'[','',[rfReplaceAll]);
03238 Value:=StringReplace(Value,']','',[rfReplaceAll]);
03239
03240 if FIndexFieldNames <> Value then begin
03241 FIndexFieldNames := Value;
03242 FSortType:=GetSortType;
03243 if (FSortType <> stIgnored) then begin {pawelsel modification}
03244 Value:=StringReplace(Value,' Desc','',[rfReplaceAll,rfIgnoreCase]);
03245 Value:=StringReplace(Value,' Asc','',[rfReplaceAll,rfIgnoreCase]);
03246 end;
03247 FSortedFields:=Value;
03248 end;
03249
03250 {Perform sorting}
03251 if Active then
03252 if (FSortedFields = '') then
03253 Self.InternalRefresh
03254 else
03255 InternalSort;
03256 end;
03257
03258 {====================end of bangfauzan addition====================}
03259
03260 end.
03261
03262