home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Vcl / dbclient.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  133KB  |  4,495 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       Client DataSet                                  }
  6. {                                                       }
  7. {       Copyright (c) 1997,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit DBClient;
  12.  
  13. {$R-,T-,H+,X+}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, ActiveX, Graphics, Classes, Controls, Forms, Db,
  18.   DSIntf, DBCommon, Midas;
  19.  
  20. type
  21.  
  22. { Exceptions }
  23.  
  24.   EDBClient = class(EDatabaseError)
  25.   private
  26.     FErrorCode: DBResult;
  27.   public
  28.     constructor Create(Message: string; ErrorCode: DBResult);
  29.     property ErrorCode: DBResult read FErrorCode;
  30.   end;
  31.  
  32.   EReconcileError = class(EDBClient)
  33.   private
  34.     FContext: string;
  35.     FPreviousError: DBResult;
  36.   public
  37.     constructor Create(NativeError, Context: string;
  38.       ErrorCode, PreviousError: DBResult);
  39.     property Context: string read FContext;
  40.     property PreviousError: DBResult read FPreviousError;
  41.   end;
  42.  
  43. { TCustomRemoteServer }
  44.  
  45.   TClientDataSet = class;
  46.  
  47.   TCustomRemoteServer = class(TCustomConnection)
  48.   protected
  49.     function GetServerList: OleVariant; virtual;
  50.     procedure GetProviderNames(Proc: TGetStrProc); virtual;
  51.   public
  52.     constructor Create(AOwner: TComponent); override;
  53.     function GetServer: IAppServer; virtual;
  54.   end;
  55.  
  56. { TAggregate }
  57.  
  58.   TAggregate = class;
  59.   TAggregates = class;
  60.   TAggUpdateEvent = procedure(Agg: TAggregate) of object;
  61.  
  62.   TAggregate = class(TCollectionItem)
  63.   private
  64.     FExpression: string;
  65.     FFldDesc: DSFLDDesc;
  66.     FHAggregate: hDSAggregate;
  67.     FAggregateName: String;
  68.     FGroupingLevel: Integer;
  69.     FDataSet: TClientDataSet;
  70.     FIndexName: string;
  71.     FDataBuffer: Array of Byte;
  72.     FDataType: TFieldType;
  73.     FDataSize: Integer;
  74.     FDependentFields: TBits;
  75.     FRecBufOfs: Integer;
  76.     FInUse: Boolean;
  77.     FActive: Boolean;
  78.     FVisible: Boolean;
  79.     FOutOfDate: Boolean;
  80.     FOnUpdate: TAggUpdateEvent;
  81.     procedure SetActive(Value: Boolean);
  82.     procedure SetExpression(const Text: string);
  83.     procedure SetGroupingLevel(GroupingLevel: Integer);
  84.     procedure SetIndexName(Value: String);
  85.   protected
  86.     procedure Activate;
  87.     property DependentFields: TBits read FDependentFields;
  88.     property RecBufOfs: Integer read FRecBufOfs write FRecBufOfs;
  89.   public
  90.     constructor Create(Aggregates: TAggregates; ADataSet: TClientDataSet); reintroduce; overload;
  91.     destructor Destroy; override;
  92.     procedure Assign(Source: TPersistent); override;
  93.     function GetDisplayName: string; override;
  94.     function Value: Variant;
  95.     property AggHandle: hDSAggregate read FHAggregate write FHAggregate;
  96.     property InUse: Boolean read FInUse write FInUse default false;
  97.     property DataSet: TClientDataSet read FDataSet;
  98.     property DataSize: Integer read FDataSize;
  99.     property DataType: TFieldType read FDataType;
  100.   published
  101.     property Active: Boolean read FActive write SetActive default False;
  102.     property AggregateName: String read FAggregateName write FAggregateName;
  103.     property Expression: string read FExpression write SetExpression;
  104.     property GroupingLevel: Integer read FGroupingLevel write SetGroupingLevel default 0;
  105.     property IndexName: string read FIndexName write SetIndexName;
  106.     property Visible: Boolean read FVisible write FVisible default True;
  107.     property OnUpdate: TAggUpdateEvent read FOnUpdate write FOnUpdate;
  108.   end;
  109.  
  110. { TAggregates }
  111.  
  112.   TAggregates = class(TCollection)
  113.   private
  114.     FOwner: TPersistent;
  115.     function GetItem(Index: Integer): TAggregate;
  116.     procedure SetItem(Index: Integer; Value: TAggregate);
  117.   protected
  118.     function GetOwner: TPersistent; override;
  119.   public
  120.     constructor Create(Owner: TPersistent);
  121.     function Add: TAggregate;
  122.     procedure Clear;
  123.     function Find(const DisplayName: string): TAggregate;
  124.     function IndexOf(const DisplayName: string): Integer;
  125.     property Items[Index: Integer]: TAggregate read GetItem write SetItem; default;
  126.   end;
  127.  
  128. { TClientDataSet }
  129.  
  130.   TFieldDescList = array of DSFLDDesc;
  131.  
  132.   TKeyIndex = (kiLookup, kiRangeStart, kiRangeEnd, kiCurRangeStart,
  133.     kiCurRangeEnd, kiSave);
  134.  
  135.   PRecInfo = ^TRecInfo;
  136.   TRecInfo = packed record
  137.     RecordNumber: Longint;
  138.     BookmarkFlag: TBookmarkFlag;
  139.     Attribute: DSAttr;
  140.   end;
  141.  
  142.   PKeyBuffer = ^TKeyBuffer;
  143.   TKeyBuffer = record
  144.     Modified: Boolean;
  145.     Exclusive: Boolean;
  146.     FieldCount: Integer;
  147.     Data: record end;
  148.   end;
  149.  
  150.   TDataPacketFormat = (dfBinary, dfXML);
  151.   
  152.   TReconcileAction = (raSkip, raAbort, raMerge, raCorrect, raCancel, raRefresh);
  153.   TReconcileErrorEvent = procedure(DataSet: TClientDataSet; E: EReconcileError;
  154.     UpdateKind: TUpdateKind; var Action: TReconcileAction) of object;
  155.   TRemoteEvent = procedure(Sender: TObject; var OwnerData: OleVariant) of object;
  156.  
  157.   TDataSetOption = (doDisableInserts, doDisableDeletes, doDisableEdits, doNoResetCall);
  158.   TDataSetOptions = set of TDataSetOption;
  159.  
  160.   TFetchOption = (foRecord, foBlobs, foDetails);
  161.   TFetchOptions = set of TFetchOption;
  162.  
  163.   TClientDataSet = class(TDataSet)
  164.   private
  165.     FActiveAggLists: TList;
  166.     FAggFieldsUpdated: TBits;
  167.     FAggFieldsInit: Boolean;
  168.     FAggFieldsSize: Integer;
  169.     FAggGrpIndOfs: Integer;
  170.     FAggFieldsOfs: Integer;
  171.     FAggGrpIndSize: Integer;
  172.     FAggregates: TAggregates;
  173.     FAggregatesActive: Boolean;
  174.     FCommandText: string;
  175.     FDSBase: IDSBase;
  176.     FDSCursor: IDSCursor;
  177.     FDSOptions: TDataSetOptions;
  178.     FFindCursor: IDSCursor;
  179.     FCloneSource: TClientDataSet;
  180.     FReconcileDataSet: TClientDataSet;
  181.     FSavedPacket: TDataPacket;
  182.     FDeltaPacket: TDataPacket;
  183.     FParams: TParams;
  184.     FIndexDefs: TIndexDefs;
  185.     FIndexName: string;
  186.     FExprFilter: HDSFilter;
  187.     FFuncFilter: HDSFilter;
  188.     FFileName: string;
  189.     FFilterBuffer: PChar;
  190.     FGroupingLevel: Integer;
  191.     FLastParentBM: array of byte;
  192.     FMasterLink: TMasterDataLink;
  193.     FIndexFieldMap: DSKEY;
  194.     FKeyBuffers: array[TKeyIndex] of PKeyBuffer;
  195.     FKeyBuffer: PKeyBuffer;
  196.     FNewValueBuffer: PChar;
  197.     FOldValueBuffer: PChar;
  198.     FCurValueBuffer: PChar;
  199.     FIndexFieldCount: Integer;
  200.     FIndexGroupingLevel: Integer;
  201.     FAppServer: IAppServer;
  202.     FProviderName: string;
  203.     FRemoteServer: TCustomRemoteServer;
  204.     FPacketRecords: Integer;
  205.     FConstDisableCount: Integer;
  206.     FMaxAggGroupingLevel: Integer;
  207.     FParentDataSet: TClientDataSet;
  208.     { Word & Byte size data members }
  209.     FKeySize: Word;
  210.     FRecordSize: Word;
  211.     FBookmarkOfs: Word;
  212.     FRecInfoOfs: Word;
  213.     FRecBufSize: Word;
  214.     FReadOnly: Boolean;
  215.     FFieldsIndex: Boolean;
  216.     FCanModify: Boolean;
  217.     FInReconcileCallback: Boolean;
  218.     FNotifyCallback: Boolean;
  219.     FOpeningFile: Boolean;
  220.     FProviderEOF: Boolean;
  221.     FFetchOnDemand: Boolean;
  222.     FStoreDefs: Boolean;
  223.     FSavePacketOnClose: Boolean;
  224.     FOnReconcileError: TReconcileErrorEvent;
  225.     FStatusFilter: TUpdateStatusSet;
  226.     FBeforeApplyUpdates: TRemoteEvent;
  227.     FAfterApplyUpdates: TRemoteEvent;
  228.     FBeforeGetRecords: TRemoteEvent;
  229.     FAfterGetRecords: TRemoteEvent;
  230.     FBeforeRowRequest: TRemoteEvent;
  231.     FAfterRowRequest: TRemoteEvent;
  232.     FBeforeExecute: TRemoteEvent;
  233.     FAfterExecute: TRemoteEvent;
  234.     FBeforeGetParams: TRemoteEvent;
  235.     FAfterGetParams: TRemoteEvent;
  236.     procedure AddExprFilter(const Expr: string; Options: TFilterOptions);
  237.     procedure AddFuncFilter;
  238.     function CalcFieldsCallBack(RecBuf: PChar): DBResult; stdcall;
  239.     procedure CheckFieldProps;
  240.     procedure CheckMasterRange;
  241.     procedure CheckProviderEOF;
  242.     procedure ClearActiveAggs;
  243.     procedure ClearSavedPacket;
  244.     procedure CloseAggs;
  245.     function CreateDSBase: IDSBase;
  246.     function CreateDSCursor(SourceCursor: IDSCursor): IDSCursor;
  247.     procedure DecodeIndexDesc(const IndexDesc: DSIDXDesc;
  248.       var Name, Fields, DescFields, CaseInsFields: string; var Options: TIndexOptions);
  249.     procedure EncodeFieldDesc(var FieldDesc: DSFLDDesc; const Name: string;
  250.       DataType: TFieldType; Size, Precision: Integer; Calculated: Boolean;
  251.       Attributes: TFieldAttributes);
  252.     procedure EncodeIndexDesc(var IndexDesc: DSIDXDesc;
  253.       const Name, Fields, DescFields, CaseInsFields: string; Options: TIndexOptions);
  254.     procedure FetchMoreData(All: Boolean);
  255.     function FilterCallback(RecBuf: PChar): Bool; stdcall;
  256.     procedure DoAggUpdates(IsUpdate: Boolean);
  257.     function  GetActiveAggs(Index: Integer) : TList;
  258.     function GetActiveRecBuf(var RecBuf: PChar): Boolean;
  259.     procedure GetAggFieldData(Buffer: PChar);
  260.     function GetChangeCount: Integer;
  261.     function GetData: OleVariant;
  262.     function GetDataSize: Integer;
  263.     function GetDelta: OleVariant;
  264.     function GetIndexDefs: TIndexDefs;
  265.     function GetIndexFieldNames: string;
  266.     function GetIndexName: string;
  267.     function GetLogChanges: Boolean;
  268.     function GetMasterFields: string;
  269.     function GetAppServer: IAppServer;
  270.     function GetProviderEOF: Boolean;
  271.     function GetSavePoint: Integer;
  272.     function GetHasAppServer: Boolean;
  273.     procedure InitBufferPointers(GetProps: Boolean);
  274.     function InternalGetGroupState(Level: Integer): TGroupPosInds;
  275.     procedure InternalFetch(Options: TFetchOptions);
  276.     procedure MasterChanged(Sender: TObject);
  277.     procedure MasterDisabled(Sender: TObject);
  278.     procedure NotifyCallback; stdcall;
  279.     procedure ReadData(Stream: TStream);
  280.     function ReconcileCallback(iRslt: Integer; iUpdateKind: DSAttr;
  281.       iResAction: dsCBRType; iErrCode: Integer; pErrMessage, pErrContext: PChar;
  282.       pRecUpd, pRecOrg, pRecConflict: Pointer; iLevels: Integer;
  283.       piFieldIDs: PInteger): dsCBRType; stdcall;
  284.     procedure ResetAgg(Agg: TAggregate; DeleteFirst: Boolean);
  285.     procedure ResetAllAggs(Value: Boolean);
  286.     procedure ResetGrouping;
  287.     procedure SetAggsActive(Value: Boolean);
  288.     procedure SaveDataPacket(XMLFormat: Boolean = False);
  289.     procedure SetData(const Value: OleVariant);
  290.     procedure SetDataSource(Value: TDataSource);
  291.     procedure SetIndex(const Value: string; FieldsIndex: Boolean);
  292.     procedure SetIndexDefs(Value: TIndexDefs);
  293.     procedure SetIndexFieldNames(const Value: string);
  294.     procedure SetIndexName(const Value: string);
  295.     procedure SetLogChanges(Value: Boolean);
  296.     procedure SetMasterFields(const Value: string);
  297.     procedure SetNotifyCallback;
  298.     procedure SetParams(Value: TParams);
  299.     procedure SetAppServer(Value: IAppServer);
  300.     procedure SetProviderEOF(Value: Boolean);
  301.     procedure SetProviderName(const Value: string);
  302.     procedure SetReadOnly(Value: Boolean);
  303.     procedure SetSavePoint(Value: Integer);
  304.     procedure SortOnFields(Cursor: IDSCursor; const Fields: string;
  305.       CaseInsensitive, Descending: Boolean);
  306.     procedure SetupConstraints;
  307.     procedure SetupInternalCalcFields(Add: Boolean);
  308.     procedure WriteData(Stream: TStream);
  309.     procedure SetAggregates(Value: TAggregates);
  310.     procedure SetStatusFilter(const Value: TUpdateStatusSet);
  311.   protected
  312.     { DataIntf Helper functions }
  313.     function DoApplyUpdates(Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer): OleVariant; virtual;
  314.     function DoGetRecords(Count: Integer; out RecsOut: Integer; Options: Integer;
  315.        const CommandText: WideString; Params: OleVariant): OleVariant; virtual;
  316.     function DoRowRequest(Row: OleVariant; RequestType: Integer): OleVariant; virtual;
  317.     procedure DoExecute(Params: OleVariant); virtual;
  318.     { DataSet methods }
  319.     procedure ResetAggField(Field: TField); override;
  320.     procedure ActivateFilters;
  321.     procedure AddDataPacket(const Data: OleVariant; HitEOF: Boolean); virtual;
  322.     procedure AddFieldDesc(FieldDescs: TFieldDescList; var DescNo: Integer;
  323.       var FieldID: Integer; FieldDefs: TFieldDefs);
  324.     procedure AllocKeyBuffers;
  325.     function AllocRecordBuffer: PChar; override;
  326.     procedure Check(Status: DBResult);
  327.     procedure CheckDetailRecords; virtual;
  328.     procedure CheckSetKeyMode;
  329.     procedure ClearCalcFields(Buffer: PChar); override;
  330.     procedure CloseCursor; override;
  331.     procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); override;
  332.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  333.     procedure DeactivateFilters;
  334.     procedure DefChanged(Sender: TObject); override;
  335.     procedure DefineProperties(Filer: TFiler); override;
  336.     procedure DestroyLookupCursor; virtual;
  337.     procedure DoBeforeInsert; override;
  338.     procedure DoOnNewRecord; override;
  339.     function FindRecord(Restart, GoForward: Boolean): Boolean; override;
  340.     procedure FreeKeyBuffers;
  341.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  342.     function GetAggregateValue(Field: TField): Variant; override;
  343.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  344.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  345.     function GetCanModify: Boolean; override;
  346.     function GetDataSource: TDataSource; override;
  347.     function GetIndexField(Index: Integer): TField;
  348.     function GetIndexFieldCount: Integer;
  349.     function GetIsIndexField(Field: TField): Boolean; override;
  350.     function GetKeyBuffer(KeyIndex: TKeyIndex): PKeyBuffer;
  351.     function GetKeyExclusive: Boolean;
  352.     function GetKeyFieldCount: Integer;
  353.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  354.     function GetRecordCount: Integer; override;
  355.     function GetRecNo: Integer; override;
  356.     function GetRecordSize: Word; override;
  357.     function GetRemoteServer: TCustomRemoteServer; virtual;
  358.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;
  359.     function InitKeyBuffer(Buffer: PKeyBuffer): PKeyBuffer;
  360.     procedure InitRecord(Buffer: PChar); override;
  361.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  362.     procedure InternalCancel; override;
  363.     procedure InternalClose; override;
  364.     procedure InternalDelete; override;
  365.     procedure InternalEdit; override;
  366.     procedure InternalFirst; override;
  367.     function InternalGetOptionalParam(const ParamName: string;
  368.       FieldNo: Integer = 0): OleVariant;
  369.     procedure InternalGotoBookmark(Bookmark: TBookmark); override;
  370.     procedure InternalHandleException; override;
  371.     procedure InternalInitFieldDefs; override;
  372.     procedure InternalInitRecord(Buffer: PChar); override;
  373.     procedure InternalInsert; override;
  374.     procedure InternalLast; override;
  375.     procedure InternalOpen; override;
  376.     procedure InternalRefresh; override;
  377.     procedure InternalPost; override;
  378.     procedure InternalSetToRecord(Buffer: PChar); override;
  379.     function IsCursorOpen: Boolean; override;
  380.     procedure Loaded; override;
  381.     function LocateRecord(const KeyFields: string; const KeyValues: Variant;
  382.       Options: TLocateOptions; SyncCursor: Boolean): Boolean;
  383.     procedure OpenCursor(InfoQuery: Boolean); override;
  384.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  385.     procedure PostKeyBuffer(Commit: Boolean);
  386.     procedure RefreshInternalCalcFields(Buffer: PChar); override;
  387.     procedure ReadDataPacket(Stream: TStream; ReadSize: Boolean);
  388.     function ResetCursorRange: Boolean;
  389.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  390.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  391.     function SetCursorRange: Boolean;
  392.     procedure SetDataSetField(const Value: TDataSetField); override;
  393.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  394.     procedure SetFilterData(const Text: string; Options: TFilterOptions);
  395.     procedure SetFiltered(Value: Boolean); override;
  396.     procedure SetFilterOptions(Value: TFilterOptions); override;
  397.     procedure SetFilterText(const Value: string); override;
  398.     procedure SetIndexField(Index: Integer; Value: TField);
  399.     procedure SetKeyBuffer(KeyIndex: TKeyIndex; Clear: Boolean);
  400.     procedure SetKeyExclusive(Value: Boolean);
  401.     procedure SetKeyFieldCount(Value: Integer);
  402.     procedure SetKeyFields(KeyIndex: TKeyIndex; const Values: array of const);
  403.     procedure SetLinkRanges(MasterFields: TList);
  404.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
  405.     procedure SetRecNo(Value: Integer); override;
  406.     procedure SetRemoteServer(Value: TCustomRemoteServer); virtual;
  407.     procedure SwitchToIndex(const IndexName: string);
  408.     procedure SyncCursors(Cursor1, Cursor2: IDSCursor);
  409.     procedure UpdateIndexDefs; override;
  410.     procedure WriteDataPacket(Stream: TStream; WriteSize: Boolean; XMLFormat: Boolean = False);
  411.     function ConstraintsStored: Boolean;
  412.     property DSBase: IDSBase read FDSBase write FDSBase;
  413.     property DSCursor: IDSCursor read FDSCursor;
  414.     property ProviderEOF: Boolean read GetProviderEOF write SetProviderEOF;
  415.   public
  416.     constructor Create(AOwner: TComponent); override;
  417.     destructor Destroy; override;
  418.     procedure AddIndex(const Name, Fields: string; Options: TIndexOptions;
  419.       const DescFields: string = ''; const CaseInsFields: string = '';
  420.       const GroupingLevel: Integer = 0);
  421.     procedure AppendData(const Data: OleVariant; HitEOF: Boolean);
  422.     procedure ApplyRange;
  423.     function ApplyUpdates(MaxErrors: Integer): Integer; virtual;
  424.     function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  425.     procedure Cancel; override;
  426.     procedure CancelRange;
  427.     procedure CancelUpdates;
  428.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  429.     procedure CreateDataSet;
  430.     procedure CloneCursor(Source: TClientDataSet; Reset: Boolean;
  431.       KeepSettings: Boolean = False);
  432.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  433.     function ConstraintsDisabled: Boolean;
  434.     function DataRequest(Data: OleVariant): OleVariant; virtual;
  435.     procedure DeleteIndex(const Name: string);
  436.     procedure DisableConstraints;
  437.     procedure EnableConstraints;
  438.     procedure EditKey;
  439.     procedure EditRangeEnd;
  440.     procedure EditRangeStart;
  441.     procedure EmptyDataSet;
  442.     procedure Execute; virtual;
  443.     procedure FetchBlobs;
  444.     procedure FetchDetails;
  445.     procedure RefreshRecord;
  446.     procedure FetchParams;
  447.     function FindKey(const KeyValues: array of const): Boolean; virtual;
  448.     procedure FindNearest(const KeyValues: array of const);
  449.     function GetCurrentRecord(Buffer: PChar): Boolean; override;
  450.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  451.     function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
  452.     function GetGroupState(Level: Integer): TGroupPosInds;
  453.     procedure GetIndexInfo(IndexName: string);
  454.     procedure GetIndexNames(List: TStrings);
  455.     function GetNextPacket: Integer;
  456.     function GetOptionalParam(const ParamName: string): OleVariant;
  457.     procedure GotoCurrent(DataSet: TClientDataSet);
  458.     function GotoKey: Boolean;
  459.     procedure GotoNearest;
  460.     property HasAppServer: Boolean read GetHasAppServer;
  461.     function Locate(const KeyFields: string; const KeyValues: Variant;
  462.       Options: TLocateOptions): Boolean; override;
  463.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  464.       const ResultFields: string): Variant; override;
  465.     procedure LoadFromFile(const FileName: string = '');
  466.     procedure LoadFromStream(Stream: TStream);
  467.     procedure MergeChangeLog;
  468.     procedure Post; override;
  469.     function Reconcile(const Results: OleVariant): Boolean;
  470.     procedure RevertRecord;
  471.     procedure SaveToFile(const FileName: string = ''; Format: TDataPacketFormat = dfBinary);
  472.     procedure SaveToStream(Stream: TStream; Format: TDataPacketFormat = dfBinary);
  473.     procedure SetAltRecBuffers(Old, New, Cur: PChar);
  474.     procedure SetKey;
  475.     procedure SetOptionalParam(const ParamName: string; const Value: OleVariant;
  476.       IncludeInDelta: Boolean = False);
  477.     procedure SetProvider(Provider: TComponent);
  478.     procedure SetRange(const StartValues, EndValues: array of const);
  479.     procedure SetRangeEnd;
  480.     procedure SetRangeStart;
  481.     function UndoLastChange(FollowChange: Boolean): Boolean;
  482.     function UpdateStatus: TUpdateStatus; override;
  483.     property ActiveAggs[Index: Integer] : TList read GetActiveAggs;
  484.     property ChangeCount: Integer read GetChangeCount;
  485.     property CloneSource: TClientDataSet read FCloneSource;
  486.     property Data: OleVariant read GetData write SetData;
  487.     property AppServer: IAppServer read GetAppServer write SetAppServer;
  488.     property DataSize: Integer read GetDataSize;
  489.     property Delta: OleVariant read GetDelta;
  490.     property GroupingLevel: Integer read FGroupingLevel;
  491.     property IndexFieldCount: Integer read GetIndexFieldCount;
  492.     property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
  493.     property KeyExclusive: Boolean read GetKeyExclusive write SetKeyExclusive;
  494.     property KeyFieldCount: Integer read GetKeyFieldCount write SetKeyFieldCount;
  495.     property KeySize: Word read FKeySize;
  496.     property LogChanges: Boolean read GetLogChanges write SetLogChanges;
  497.     property SavePoint: Integer read GetSavePoint write SetSavePoint;
  498.     property StatusFilter: TUpdateStatusSet read FStatusFilter write SetStatusFilter;
  499.   published
  500.     property Active;
  501.     property Aggregates: TAggregates read FAggregates write SetAggregates;
  502.     property AggregatesActive: Boolean read FAggregatesActive write SetAggsActive default False;
  503.     property AutoCalcFields;
  504.     property CommandText: string read FCommandText write FCommandText;
  505.     property Constraints stored ConstraintsStored;
  506.     property DataSetField;
  507.     property FileName: string read FFileName write FFileName;
  508.     property Filter;
  509.     property Filtered;
  510.     property FilterOptions;
  511.     property FieldDefs stored FStoreDefs;
  512.     property IndexDefs: TIndexDefs read GetIndexDefs write SetIndexDefs stored FStoreDefs;
  513.     property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
  514.     property IndexName: string read GetIndexName write SetIndexName;
  515.     property FetchOnDemand: Boolean read FFetchOnDemand write FFetchOnDemand default True;
  516.     property MasterFields: string read GetMasterFields write SetMasterFields;
  517.     property MasterSource: TDataSource read GetDataSource write SetDataSource;
  518.     property ObjectView default True;
  519.     property PacketRecords: Integer read FPacketRecords write FPacketRecords default -1;
  520.     property Params: TParams read FParams write SetParams;
  521.     property ProviderName: string read FProviderName write SetProviderName;
  522.     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  523.     property RemoteServer: TCustomRemoteServer read GetRemoteServer write SetRemoteServer;
  524.     property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
  525.     property BeforeOpen;
  526.     property AfterOpen;
  527.     property BeforeClose;
  528.     property AfterClose;
  529.     property BeforeInsert;
  530.     property AfterInsert;
  531.     property BeforeEdit;
  532.     property AfterEdit;
  533.     property BeforePost;
  534.     property AfterPost;
  535.     property BeforeCancel;
  536.     property AfterCancel;
  537.     property BeforeDelete;
  538.     property AfterDelete;
  539.     property BeforeScroll;
  540.     property AfterScroll;
  541.     property BeforeRefresh;
  542.     property AfterRefresh;
  543.     property OnCalcFields;
  544.     property OnDeleteError;
  545.     property OnEditError;
  546.     property OnFilterRecord;
  547.     property OnNewRecord;
  548.     property OnPostError;
  549.     property OnReconcileError: TReconcileErrorEvent read FOnReconcileError write FOnReconcileError;
  550.     property BeforeApplyUpdates: TRemoteEvent read FBeforeApplyUpdates write FBeforeApplyUpdates;
  551.     property AfterApplyUpdates: TRemoteEvent read FAfterApplyUpdates write FAfterApplyUpdates;
  552.     property BeforeGetRecords: TRemoteEvent read FBeforeGetRecords write FBeforeGetRecords;
  553.     property AfterGetRecords: TRemoteEvent read FAfterGetRecords write FAfterGetRecords;
  554.     property BeforeRowRequest: TRemoteEvent read FBeforeRowRequest write FBeforeRowRequest;
  555.     property AfterRowRequest: TRemoteEvent read FAfterRowRequest write FAfterRowRequest;
  556.     property BeforeExecute: TRemoteEvent read FBeforeExecute write FBeforeExecute;
  557.     property AfterExecute: TRemoteEvent read FAfterExecute write FAfterExecute;
  558.     property BeforeGetParams: TRemoteEvent read FBeforeGetParams write FBeforeGetParams;
  559.     property AfterGetParams: TRemoteEvent read FAfterGetParams write FAfterGetParams;
  560.   end;
  561.  
  562. { TClientBlobStream }
  563.  
  564.   TClientBlobStream = class(TMemoryStream)
  565.   private
  566.     FField: TBlobField;
  567.     FDataSet: TClientDataSet;
  568.     FBuffer: PChar;
  569.     FFieldNo: Integer;
  570.     FModified: Boolean;
  571.     procedure ReadBlobData;
  572.   public
  573.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  574.     destructor Destroy; override;
  575.     function Write(const Buffer; Count: Longint): Longint; override;
  576.     procedure Truncate;
  577.   end;
  578.  
  579. const
  580.   AllParamTypes = [ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult];
  581.  
  582. function PackageParams(Params: TParams; Types: TParamTypes = AllParamTypes): OleVariant;
  583. procedure UnpackParams(const Source: OleVariant; Dest: TParams);
  584.  
  585. const
  586.   AllRecords = -1;
  587.  
  588. implementation
  589.  
  590. uses DBConsts, MidConst, Provider, TypInfo, ComObj;
  591.  
  592. { Exceptions }
  593.  
  594. constructor EDBClient.Create(Message: string; ErrorCode: DBResult);
  595. begin
  596.   FErrorCode := ErrorCode;
  597.   inherited Create(Message);
  598. end;
  599.  
  600. constructor EReconcileError.Create(NativeError, Context: string;
  601.   ErrorCode, PreviousError: DBResult);
  602. begin
  603.   FContext := Context;
  604.   FPreviousError := PreviousError;
  605.   inherited Create(NativeError, ErrorCode);
  606. end;
  607.  
  608. { Utility functions }
  609.  
  610. function PackageParams(Params: TParams; Types: TParamTypes = AllParamTypes): OleVariant;
  611. var
  612.   I, Idx, Count: Integer;
  613. begin
  614.   Result := NULL;
  615.   Count := 0;
  616.   for I := 0 to Params.Count - 1 do
  617.     if Params[I].ParamType in Types then Inc(Count);
  618.   if Count > 0 then
  619.   begin
  620.     Idx := 0;
  621.     Result := VarArrayCreate([0, Count - 1], varVariant);
  622.     for I := 0 to Params.Count - 1 do
  623.       with Params[I] do
  624.         if ParamType in Types then
  625.         begin
  626.           Result[Idx] := VarArrayOf([Name, Value, Ord(DataType), Ord(ParamType)]);
  627.           Inc(Idx);
  628.         end;
  629.   end;
  630. end;
  631.  
  632. procedure UnpackParams(const Source: OleVariant; Dest: TParams);
  633. var
  634.   TempParams: TParams;
  635.   i: Integer;
  636. begin
  637.   if not VarIsNull(Source) and VarIsArray(Source) and VarIsArray(Source[0]) then
  638.   begin
  639.     TempParams := TParams.Create;
  640.     try
  641.       for i := 0 to VarArrayHighBound(Source, 1) do
  642.       begin
  643.         with TParam(TempParams.Add) do
  644.         begin
  645.           if VarArrayHighBound(Source[i], 1) > 1 then
  646.             DataType := TFieldType(Source[i][2]);
  647.           if VarArrayHighBound(Source[i], 1) > 2 then
  648.             ParamType := TParamType(Source[i][3]);
  649.           Name := Source[i][0];
  650.           Value := Source[i][1];
  651.         end;
  652.       end;
  653.       Dest.Assign(TempParams);
  654.     finally
  655.       TempParams.Free;
  656.     end;
  657.   end;
  658. end;
  659.  
  660. { TCustomRemoteServer }
  661.  
  662. constructor TCustomRemoteServer.Create(AOwner: TComponent);
  663. begin
  664.   inherited Create(AOwner);
  665.   RCS;
  666. end;
  667.  
  668. function TCustomRemoteServer.GetServerList: OleVariant;
  669. begin
  670.   Result := NULL;
  671. end;
  672.  
  673. function TCustomRemoteServer.GetServer: IAppServer;
  674. begin
  675.   Result := nil;
  676. end;
  677.  
  678. procedure TCustomRemoteServer.GetProviderNames(Proc: TGetStrProc);
  679. begin
  680. end;
  681.  
  682. { TClientDataSet }
  683.  
  684. constructor TClientDataSet.Create(AOwner: TComponent);
  685. begin
  686.   inherited Create(AOwner);
  687.   FMasterLink := TMasterDataLink.Create(Self);
  688.   FMasterLink.OnMasterChange := MasterChanged;
  689.   FMasterLink.OnMasterDisable := MasterDisabled;
  690.   FPacketRecords := AllRecords;
  691.   FFetchOnDemand := True;
  692.   FParams := TParams.Create(Self);
  693.   FAggregates := TAggregates.Create(Self);
  694.   FActiveAggLists := TList.Create;
  695.   FOpeningFile := False;
  696.   ObjectView := True;
  697.   RCS;
  698. end;
  699.  
  700. destructor TClientDataSet.Destroy;
  701. begin
  702.   FSavePacketOnClose := False;
  703.   inherited Destroy;
  704.   ClearSavedPacket;
  705.   FreeDataPacket(FDeltaPacket);
  706.   SetRemoteServer(nil);
  707.   AppServer := nil;
  708.   FMasterLink.Free;
  709.   FIndexDefs.Free;
  710.   FParams.Free;
  711.   FAggregates.Free;
  712.   ClearActiveAggs;
  713.   FActiveAggLists.Free;
  714.   FAggFieldsUpdated.Free;
  715. end;
  716.  
  717. function TClientDataSet.CreateDSBase: IDSBase;
  718. begin
  719.   CreateDbClientObject(CLSID_DSBase, IDSBase, Result);
  720. end;
  721.  
  722. function TClientDataSet.CreateDSCursor(SourceCursor: IDSCursor): IDSCursor;
  723. begin
  724.   CreateDbClientObject(CLSID_DSCursor, IDSCursor, Result);
  725.   if Assigned(SourceCursor) then
  726.     Check(Result.CloneCursor(SourceCursor)) else
  727.     Check(Result.InitCursor(FDSBase));
  728. end;
  729.  
  730. procedure TClientDataSet.SetParams(Value: TParams);
  731. begin
  732.   FParams.Assign(Value);
  733. end;
  734.  
  735. procedure TClientDataSet.SetOptionalParam(const ParamName: string;
  736.   const Value: OleVariant; IncludeInDelta: Boolean);
  737. const
  738.   ParamTypeMap: array[varSmallInt..varByte] of Integer =
  739.     ( dsfldINT, dsfldINT, dsfldFLOATIEEE, dsfldFLOATIEEE, dsfldBCD,
  740.       dsfldTIMESTAMP, dsfldZSTRING, 0, 0, dsfldBOOL, 0, 0, 0, 0, 0, dsfldINT);
  741.   ParamTypeSize: array[varSmallInt..varByte] of Integer =
  742.     ( SizeOf(SmallInt), SizeOf(Integer), SizeOf(Single), SizeOf(Double),
  743.       SizeOf(Currency), SizeOf(TDateTime), 0, 0, 0, SizeOf(WordBool), 0, 0, 0,
  744.       0, 0, SizeOf(Byte));
  745. var
  746.   ParamType, ParamLen, t, l: DWord;
  747.   S: string;
  748.   P: Pointer;
  749.   Unlock: Boolean;
  750.   V, Name: Pointer;
  751. begin
  752.   CheckActive;
  753.   if ((VarType(Value) and varTypeMask) in [varSmallInt, varInteger, varSingle,
  754.       varDouble, varCurrency, varDate, varOleStr, varBoolean, varByte]) and
  755.      ((not VarIsArray(Value)) or (VarType(Value) and varTypeMask = varByte)) then
  756.   begin
  757.     Unlock := False;
  758.     try
  759.       ParamType := ParamTypeMap[VarType(Value) and varTypeMask];
  760.       ParamLen := ParamTypeSize[VarType(Value) and varTypeMask];
  761.       if ParamType = dsfldZSTRING then
  762.       begin
  763.         S := Value;
  764.         P := PChar(S);
  765.         ParamLen := Length(S) + 1;
  766.       end else
  767.       if VarIsArray(Value) then
  768.       begin
  769.         ParamType := dsfldBYTES;
  770.         ParamLen := VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1);
  771.         P := VarArrayLock(Value);
  772.         Unlock := True;
  773.       end else
  774.       if (VarType(Value) and varByRef) = varByRef then
  775.         P := TVarData(Value).VPointer else
  776.         P := @TVarData(Value).VPointer;
  777.       ParamType := ParamType shl dsSizeBitsLen or ParamLen;
  778.       if IncludeInDelta then
  779.         ParamType := ParamType or dsIncInDelta;
  780.       Name := PChar(ParamName);
  781.       if FDSBase.GetOptParameter(0, 0, Name, t, l, v) = 0 then
  782.         Check(FDSBase.DropOptParameter(0, PChar(ParamName)));
  783.       Check(FDSBase.AddOptParameter(0, PChar(ParamName), ParamType, ParamLen, P));
  784.     finally
  785.       if Unlock then
  786.         VarArrayUnlock(Value);
  787.     end;
  788.   end else
  789.     DatabaseError(SInvalidOptParamType, Self);
  790. end;
  791.  
  792. function TClientDataSet.GetOptionalParam(const ParamName: string): OleVariant;
  793. begin
  794.   Result := InternalGetOptionalParam(ParamName);
  795. end;
  796.  
  797. function TClientDataSet.InternalGetOptionalParam(const ParamName: string;
  798.   FieldNo: Integer = 0): OleVariant;
  799. var
  800.   ParamType, ParamLen: DWord;
  801.   Name: PChar;
  802.   Value, P: Pointer;
  803.   S: string;
  804. begin
  805.   if not Assigned(FDSBase) then CheckActive;
  806.   VarClear(Result);
  807.   Name := PChar(ParamName);
  808.   if FDSBase.GetOptParameter(0, FieldNo, Pointer(Name), ParamType,
  809.     ParamLen, Value) <> 0 then Exit;
  810.   case (ParamType and dsTypeBitsMask) shr dsSizeBitsLen of
  811.     dsfldINT,
  812.     dsfldUINT:
  813.     begin
  814.       case ParamLen of
  815.         1: Result := Byte(Value^);
  816.         2: Result := SmallInt(Value^);
  817.         4: Result := Integer(Value^);
  818.       end;
  819.     end;
  820.     dsfldBOOL: Result := WordBool(Value^);
  821.     dsfldFLOATIEEE: Result := Double(Value^);
  822.     dsfldBCD: Result := Currency(Value^);
  823.     dsfldDATE: Result := TDateTimeRec(Value^).Date - DateDelta;
  824.     dsfldTIME: Result := TDateTimeRec(Value^).Time / MSecsPerDay;
  825.     dsfldTIMESTAMP: Result := (TDateTimeRec(Value^).DateTime / MSecsPerDay) - DateDelta;
  826.     dsfldZSTRING:
  827.     begin
  828.       SetString(S, PChar(Value), ParamLen-1);
  829.       Result := S;
  830.     end;
  831.     dsfldBYTES:
  832.     begin
  833.       Result := VarArrayCreate([0, ParamLen], varByte);
  834.       P := VarArrayLock(Result);
  835.       try
  836.         Move(Value^, P^, ParamLen);
  837.       finally
  838.         VarArrayUnlock(Result);
  839.       end;
  840.     end;
  841.   else
  842.     VarClear(Result);
  843.   end;
  844. end;
  845.  
  846. procedure TClientDataSet.OpenCursor(InfoQuery: Boolean);
  847. var
  848.   RecsOut: Integer;
  849.   Options: TGetRecordOptions;
  850.   DataPacket: TDataPacket;
  851.   Stream: TFileStream;
  852. begin
  853.   FProviderEOF := True;
  854.   FSavePacketOnClose := False;
  855.   if not FOpeningFile and (FileName <> '') and FileExists(FileName) then
  856.   begin
  857.     Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  858.     try
  859.       ReadDataPacket(Stream, False);
  860.     finally
  861.       Stream.Free;
  862.     end;
  863.   end;
  864.   if DataSetField <> nil then
  865.   begin
  866.     FParentDataSet := DataSetField.DataSet as TClientDataSet;
  867.     OpenParentDataSet(FParentDataSet);
  868.     Check(FParentDataSet.DSBase.GetEmbeddedDS(DataSetField.FieldNo, FDSBase));
  869.     FieldDefs.HiddenFields := FParentDataSet.FieldDefs.HiddenFields;
  870.   end
  871.   else if not Assigned(FDSBase) then
  872.   begin
  873.     if Assigned(FSavedPacket) then DataPacket := FSavedPacket else
  874.     begin
  875.       Options := [grMetaData];
  876.       DataPacket := VarToDataPacket(DoGetRecords(FPacketRecords, RecsOut,
  877.         Byte(Options), CommandText, PackageParams(Params)));
  878.       ProviderEOF := RecsOut <> FPacketRecords;
  879.     end;
  880.     if not Assigned(DataPacket) then DatabaseError(SNoDataProvider, Self);
  881.     FDSBase := CreateDSBase;
  882.     Check(FDSBase.AppendData(DataPacket, ProviderEOF));
  883.   end;
  884.   inherited OpenCursor(InfoQuery);
  885.   if not InfoQuery and Assigned(FCloneSource) and not FCloneSource.BOF then
  886.   begin
  887.     SyncCursors(FDSCursor, FCloneSource.FDSCursor);
  888.     CursorPosChanged;
  889.     Resync([]);
  890.   end;
  891.   { DSBase now has the data packet so we don't need to hold on to it }
  892.   ClearSavedPacket;
  893.   FSavePacketOnClose := True;
  894. end;
  895.  
  896. procedure TClientDataSet.FetchParams;
  897. var
  898.   OwnerData: OleVariant;
  899. begin
  900.   if Assigned(FBeforeExecute) then FBeforeExecute(Self, OwnerData);
  901.   UnpackParams(AppServer.AS_GetParams(ProviderName, OwnerData), Params);
  902.   if Assigned(FAfterExecute) then FAfterExecute(Self, OwnerData);
  903. end;
  904.  
  905. procedure TClientDataSet.Check(Status: DBResult);
  906. var
  907.   ErrMsg: array[0..2048] of Char;
  908. begin
  909.   if Status <> 0 then
  910.   begin
  911.     FDSBase.GetErrorString(Status, ErrMsg);
  912.     raise EDBClient.Create(ErrMsg, Status);
  913.   end;
  914. end;
  915.  
  916. procedure TClientDataSet.CloseCursor;
  917. var
  918.   Params: OleVariant;
  919.   RecsOut: Integer;
  920.   Options: TGetRecordOptions;
  921. begin
  922.   if (FileName <> '') and not (csDesigning in ComponentState) then
  923.     SaveToFile(FileName);
  924.   inherited CloseCursor;
  925.   if HasAppServer then
  926.   begin
  927.     if not (csDestroying in ComponentState) then
  928.     begin
  929.       if FMasterLink.Active and (FMasterLink.Fields.Count > 0) and
  930.         (PacketRecords = 0) then
  931.         Params := Null else
  932.         Params := Unassigned;
  933.       if not (doNoResetCall in FDSOptions) then
  934.       begin
  935.         Options := [grReset];
  936.         DoGetRecords(0, RecsOut, Byte(Options), '', Unassigned);
  937.       end;
  938.       FAppServer := nil;
  939.     end;
  940.   end
  941.   else if FSavePacketOnClose  and (FileName <> '') then
  942.     SaveDataPacket;
  943.   FDSBase := nil;
  944.   FParentDataSet := nil;
  945. end;
  946.  
  947. procedure TClientDataSet.DefChanged(Sender: TObject);
  948. begin
  949.   FStoreDefs := True;
  950. end;
  951.  
  952. procedure TClientDataSet.InternalInitFieldDefs;
  953. var
  954.   FieldID, I: Integer;
  955.   FieldDescs: TFieldDescList;
  956.   CursorProps: DSProps;
  957. begin
  958.   FDSBase.SetProp(dspropCOMPRESSARRAYS, Integer(True));
  959.   Check(FDSBase.GetProps(CursorProps));
  960.   SetLength(FieldDescs, CursorProps.iFields);
  961.   Check(FDSBase.GetFieldDescs(PDSFldDesc(FieldDescs)));
  962.   FieldDefs.Clear;
  963.   I := 0;
  964.   FieldID := 1;
  965.   while I < CursorProps.iFields do
  966.     AddFieldDesc(FieldDescs, I, FieldID, FieldDefs);
  967. end;
  968.  
  969. type
  970.   TPropReader = class(TReader);
  971.  
  972. procedure TClientDataSet.CheckFieldProps;
  973.  
  974.   procedure GetTypeName(Field: TObjectField);
  975.   var
  976.     V: Variant;
  977.     i: Integer;
  978.   begin
  979.     V := InternalGetOptionalParam(szTYPENAME, Field.FieldNo);
  980.     if not VarIsNull(V) and not VarIsEmpty(V) then
  981.       Field.ObjectType := V;
  982.     if Field.DataType in [ftADT, ftArray] then
  983.       for i := 0 to Field.FieldCount - 1 do
  984.         if Field.Fields[i] is TObjectField then
  985.           GetTypeName(TObjectField(Field.Fields[i]));
  986.   end;
  987.  
  988. var
  989.   V: Variant;
  990.   P: Pointer;
  991.   Stream: TMemoryStream;
  992.   Reader: TPropReader;
  993.   i: Integer;
  994. begin
  995.   Stream := TMemoryStream.Create;
  996.   try
  997.     for i := 0 to FieldCount - 1 do
  998.     begin
  999.       if Fields[i] is TObjectField then
  1000.         GetTypeName(TObjectField(Fields[i]));
  1001.       V := InternalGetOptionalParam(szORIGIN, Fields[i].FieldNo);
  1002.       if not VarIsNull(V) and not VarIsEmpty(V) then
  1003.         Fields[i].Origin := VarToStr(V);
  1004.       V := InternalGetOptionalParam(szFIELDPROPS, Fields[i].FieldNo);
  1005.       if VarIsNull(V) or VarIsEmpty(V) or not VarIsArray(V) then continue;
  1006.       Stream.Size := VarArrayHighBound(V, 1) - SizeOf(Integer);
  1007.       P := VarArrayLock(V);
  1008.       try
  1009.         Stream.Position := 0;
  1010.         Stream.Write(Pointer(Integer(P) + SizeOf(Integer))^, Stream.Size);
  1011.         Stream.Position := 0;
  1012.       finally
  1013.         VarArrayUnlock(V);
  1014.       end;
  1015.       V := NULL;
  1016.       Reader := TPropReader.Create(Stream, 1024);
  1017.       try
  1018.         Reader.ReadListBegin;
  1019.         while not Reader.EndOfList do
  1020.           Reader.ReadProperty(Fields[i]);
  1021.       finally
  1022.         Stream.Clear;
  1023.         Reader.Free;
  1024.       end;
  1025.     end;
  1026.   finally
  1027.     Stream.Free;
  1028.   end;
  1029. end;
  1030.  
  1031. procedure TClientDataSet.InternalOpen;
  1032.  
  1033.   function GetBoolParam(const ParamName: string): Boolean;
  1034.   var
  1035.     V: OleVariant;
  1036.   begin
  1037.     V := GetOptionalParam(ParamName);
  1038.     Result := not VarIsNull(V) and not VarIsEmpty(V) and (VarType(V) = varBoolean);
  1039.     if Result then
  1040.       Result := V;
  1041.   end;
  1042.  
  1043. var
  1044.   CursorProps: DSProps;
  1045. begin
  1046.   if Assigned(FCloneSource) then
  1047.     FDSCursor := CreateDSCursor(FCloneSource.FDSCursor)
  1048.   else
  1049.   begin
  1050.     SetupInternalCalcFields(True);
  1051.     FDSCursor := CreateDSCursor(nil);
  1052.   end;
  1053.   if DataSetField <> nil then
  1054.     Check(FParentDataSet.FDSCursor.LinkCursors(0, nil, nil, FDSCursor));
  1055.   FDSOptions := [];
  1056.   if GetBoolParam(szDISABLE_EDITS) then
  1057.     Include(FDSOptions, doDisableEdits);
  1058.   if GetBoolParam(szDISABLE_INSERTS) then
  1059.     Include(FDSOptions, doDisableInserts);
  1060.   if GetBoolParam(szDISABLE_DELETES) then
  1061.     Include(FDSOptions, doDisableDeletes);
  1062.   if GetBoolParam(szNO_RESET_CALL) then
  1063.     Include(FDSOptions, doNoResetCall);
  1064.   Check(FDSCursor.GetCursorProps(CursorProps));
  1065.   FRecordSize := CursorProps.iRecBufSize;
  1066.   BookmarkSize := CursorProps.iBookmarkSize;
  1067.   SetLength(FLastParentBM, BookMarkSize);
  1068.   FCanModify := not CursorProps.bReadOnly;
  1069.   FieldDefs.Updated := False;
  1070.   FieldDefs.Update;
  1071.   FieldDefList.Update;
  1072.   IndexDefs.Updated := False;
  1073.   GetIndexInfo('');
  1074.   if DefaultFields then CreateFields;
  1075.   BindFields(True);
  1076.   CheckFieldProps;
  1077.   AllocKeyBuffers;
  1078.   FDSCursor.MoveToBOF;
  1079.   if not Assigned(FCloneSource) then
  1080.   begin
  1081.     if InternalCalcFields and not (csDesigning in ComponentState) then
  1082.       Check(FDSBase.SetFieldCalculation(Integer(Self),
  1083.         @TClientDataSet.CalcFieldsCallback));
  1084.     if FIndexName <> '' then
  1085.        if FFieldsIndex then
  1086.          SortOnFields(FDSCursor, FIndexName, False, False) else
  1087.          SwitchToIndex(FIndexName);
  1088.     CheckMasterRange;
  1089.     if FReadOnly then FDSBase.SetProp(dspropREADONLY, Integer(True));
  1090.     ResetAllAggs(FAggregatesActive);
  1091.     if Filtered then ActivateFilters;
  1092.   end;
  1093.   InitBufferPointers(False);
  1094.   if (DataSetField <> nil) and FetchOnDemand then
  1095.     CheckDetailRecords;
  1096.   SetupConstraints;
  1097. end;
  1098.  
  1099. procedure TClientDataSet.InternalClose;
  1100. begin
  1101.   if Filtered then DeactivateFilters;
  1102.   FreeKeyBuffers;
  1103.   if not Assigned(FCloneSource) then
  1104.     SetupInternalCalcFields(False);
  1105.   BindFields(False);
  1106.   if DefaultFields then DestroyFields;
  1107.   CloseAggs;
  1108.   FIndexFieldCount := 0;
  1109.   FKeySize := 0;
  1110.   FDSCursor := nil;
  1111.   FFindCursor := nil;
  1112.   FNotifyCallback := False;
  1113. end;
  1114.  
  1115. procedure TClientDataSet.InternalRefresh;
  1116. const
  1117.   Options: TGetRecordOptions = [grReset];
  1118. var
  1119.   SeqNo: DWord;
  1120.   RecCount, RecsOut: Integer;
  1121.   DataPacket: TDataPacket;
  1122. begin
  1123.   CheckBrowseMode;
  1124.   if ChangeCount > 0 then
  1125.     DatabaseError(SRefreshError, Self);
  1126.   if FMasterLink.Active and (FMasterLink.Fields.Count > 0) and
  1127.      ((DataSetField <> nil) or (PacketRecords <> -1)) then
  1128.   begin
  1129.     FDSBase.Reset;
  1130.     if FetchOnDemand then CheckDetailRecords;
  1131.   end else
  1132.   begin
  1133.     FDSCursor.GetSequenceNumber(SeqNo);
  1134.     if not ProviderEOF then
  1135.       FDSBase.GetProp(dspropRECORDSINDS, @RecCount) else
  1136.       RecCount := AllRecords;
  1137.     DataPacket := VarToDataPacket(DoGetRecords(RecCount, RecsOut, Byte(Options), '', Unassigned));
  1138.     ProviderEOF := RecsOut <> RecCount;
  1139.     FDSBase.Reset;
  1140.     FDSBase.SetProp(dspropDSISPARTIAL, Integer(False));
  1141.     Check(FDSBase.AppendData(DataPacket, ProviderEOF));
  1142.     FDSCursor.MoveToSeqNo(SeqNo);
  1143.   end;
  1144. end;
  1145.  
  1146. function TClientDataSet.IsCursorOpen: Boolean;
  1147. begin
  1148.   Result := FDSCursor <> nil;
  1149. end;
  1150.  
  1151. procedure TClientDataSet.InternalHandleException;
  1152. begin
  1153.   Application.HandleException(Self)
  1154. end;
  1155.  
  1156. procedure TClientDataSet.SetData(const Value: OleVariant);
  1157. begin
  1158.   FSavePacketOnClose := False;
  1159.   Close;
  1160.   ClearSavedPacket;
  1161.   if not VarIsNull(Value) then
  1162.   begin
  1163.     SafeArrayCopy(VarToDataPacket(Value), FSavedPacket);
  1164.     Open;
  1165.   end;
  1166. end;
  1167.  
  1168. function TClientDataSet.GetData: OleVariant;
  1169. var
  1170.   DataPacket: TDataPacket;
  1171. begin
  1172.   if Active then
  1173.   begin
  1174.     CheckBrowseMode;
  1175.     Check(FDSBase.StreamDS(DataPacket));
  1176.   end else
  1177.     DataPacket := FSavedPacket;
  1178.   DataPacketToVariant(DataPacket, Result);
  1179. end;
  1180.  
  1181. procedure TClientDataSet.ClearSavedPacket;
  1182. begin
  1183.   FreeDataPacket(FSavedPacket);
  1184. end;
  1185.  
  1186. procedure TClientDataSet.SaveDataPacket(XMLFormat: Boolean = False);
  1187. const
  1188.   StreamMode: array[Boolean] of DWord = (xmlOFF, xmlON); 
  1189. begin
  1190.   if Assigned(FDSBase) and (DataSetField = nil) then
  1191.   begin
  1192.     FDSBase.SetProp(dspropXML_STREAMMODE, StreamMode[XMLFormat]);
  1193.     ClearSavedPacket;
  1194.     Check(FDSBase.StreamDS(FSavedPacket));
  1195.   end;
  1196. end;
  1197.  
  1198. function TClientDataSet.GetDataSize: Integer;
  1199. begin
  1200.   if Assigned(DataSetField) then
  1201.     Result := -1
  1202.   else if Active then
  1203.   begin
  1204.     SaveDataPacket;
  1205.     Result := DataPacketSize(FSavedPacket);
  1206.     ClearSavedPacket;
  1207.   end
  1208.   else if Assigned(FSavedPacket) then
  1209.     Result := DataPacketSize(FSavedPacket)
  1210.   else
  1211.     Result := 0;
  1212. end;
  1213.  
  1214. procedure TClientDataSet.FetchMoreData(All: Boolean);
  1215. var
  1216.   Count: Integer;
  1217.   RecsOut: Integer;
  1218. begin
  1219.   if All then Count := AllRecords else Count := FPacketRecords;
  1220.   if Count = 0 then Exit;
  1221.   AddDataPacket(DoGetRecords(Count, RecsOut, 0, '', Unassigned), RecsOut <> Count);
  1222.   ProviderEOF := RecsOut <> Count;
  1223. end;
  1224.  
  1225. procedure TClientDataSet.InternalFetch(Options: TFetchOptions);
  1226. var
  1227.   DataPacket: TDataPacket;
  1228.   NewData: OleVariant;
  1229.   BaseDS: TClientDataSet;
  1230. begin
  1231.   CheckActive;
  1232.   UpdateCursorPos;
  1233.   Check(DSCursor.GetRowRequestPacket(foRecord in Options, foBlobs in Options,
  1234.     foDetails in Options, True, DataPacket));
  1235.   DataPacketToVariant(DataPacket, NewData);
  1236.   BaseDS := Self;
  1237.   while Assigned(BaseDS.FParentDataSet) do BaseDS := BaseDS.FParentDataSet;
  1238.   NewData := BaseDS.DoRowRequest(NewData, Byte(Options));
  1239.   UpdateCursorPos;
  1240.   Check(DSCursor.RefreshRecord(VarToDataPacket(NewData)));
  1241.   DSCursor.GetCurrentRecord(ActiveBuffer);
  1242.   if Options = [foDetails] then
  1243.     DataEvent(deDataSetChange, 0);
  1244. end;
  1245.  
  1246. procedure TClientDataSet.FetchBlobs;
  1247. begin
  1248.   InternalFetch([foBlobs]);
  1249. end;
  1250.  
  1251. procedure TClientDataSet.FetchDetails;
  1252. begin
  1253.   InternalFetch([foDetails]);
  1254. end;
  1255.  
  1256. procedure TClientDataSet.RefreshRecord;
  1257. begin
  1258.   InternalFetch([foRecord]);
  1259. end;
  1260.  
  1261. procedure TClientDataSet.CheckProviderEOF;
  1262. begin
  1263.   if HasAppServer and not ProviderEOF and FFetchOnDemand and (FPacketRecords <> 0) then
  1264.     FetchMoreData(True);
  1265. end;
  1266.  
  1267. procedure TClientDataSet.AddDataPacket(const Data: OleVariant; HitEOF: Boolean);
  1268. begin
  1269.   Check(FDSBase.AppendData(VarToDataPacket(Data), HitEOF));
  1270. end;
  1271.  
  1272. procedure TClientDataSet.AppendData(const Data: OleVariant; HitEOF: Boolean);
  1273. begin
  1274.   if not Active then
  1275.   begin
  1276.     Self.Data := Data;
  1277.     if not HitEOF then
  1278.       FDSBase.SetProp(dspropDSISPARTIAL, Integer(False));
  1279.   end else
  1280.   begin
  1281.     AddDataPacket(Data, HitEOF);
  1282.     if State <> dsBrowse then Exit;
  1283.     if IsEmpty then First else
  1284.     begin
  1285.       UpdateCursorPos;
  1286.       Resync([]);
  1287.     end;
  1288.   end;
  1289. end;
  1290.  
  1291. function TClientDataSet.GetNextPacket: Integer;
  1292. begin
  1293.   CheckActive;
  1294.   if ProviderEOF then Result := 0 else
  1295.   begin
  1296.     UpdateCursorPos;
  1297.     if (FPacketRecords = 0) and FMasterLink.Active and
  1298.        (FMasterLink.Fields.Count > 0) then CheckDetailRecords else
  1299.     begin
  1300.       AddDataPacket(DoGetRecords(FPacketRecords, Result, 0, '', Unassigned),
  1301.         Result <> FPacketRecords);
  1302.       ProviderEOF := Result <> FPacketRecords;
  1303.     end;
  1304.     Resync([]);
  1305.   end;
  1306. end;
  1307.  
  1308. procedure TClientDataSet.SetProviderName(const Value: string);
  1309. begin
  1310.   if Value = FProviderName then Exit;
  1311.   if (Value <> '') then
  1312.   begin
  1313.     CheckInactive;
  1314.     ClearSavedPacket;
  1315.   end;
  1316.   FAppServer := nil;
  1317.   FProviderName := Value;
  1318. end;
  1319.  
  1320. procedure TClientDataSet.SetProvider(Provider: TComponent);
  1321. begin
  1322.   if Provider is TCustomProvider then
  1323.     AppServer := TLocalAppServer.Create(TCustomProvider(Provider)) else
  1324.     AppServer := nil;
  1325. end;
  1326.  
  1327. function TClientDataSet.GetAppServer: IAppServer;
  1328. var
  1329.   ProvComp: TComponent;
  1330.   DS: TObject;
  1331. begin
  1332.   if not HasAppServer then
  1333.   begin
  1334.     if ProviderName <> '' then
  1335.       if Assigned(RemoteServer) then
  1336.         FAppServer := RemoteServer.GetServer else
  1337.       begin
  1338.         if Assigned(Owner) then
  1339.         begin
  1340.           ProvComp := Owner.FindComponent(ProviderName);
  1341.           if Assigned(ProvComp) and (ProvComp is TCustomProvider) then
  1342.           begin
  1343.             DS := GetObjectProperty(ProvComp, 'DataSet');
  1344.             if Assigned(DS) and (DS = Self) then
  1345.               DatabaseError(SNoCircularReference, Self);
  1346.             FAppServer := TLocalAppServer.Create(TCustomProvider(ProvComp));
  1347.           end;
  1348.         end;
  1349.       end;
  1350.     if not HasAppServer then
  1351.       DatabaseError(SNoDataProvider, Self);
  1352.   end;
  1353.   Result := FAppServer;
  1354. end;
  1355.  
  1356. function TClientDataSet.GetHasAppServer: Boolean;
  1357. begin
  1358.   Result := Assigned(FAppServer);
  1359. end;
  1360.  
  1361. procedure TClientDataSet.SetAppServer(Value: IAppServer);
  1362. begin
  1363.   FAppServer := Value;
  1364.   if Assigned(Value) then
  1365.     ClearSavedPacket;
  1366. end;
  1367.  
  1368. procedure TClientDataSet.SetProviderEOF(Value: Boolean);
  1369. begin
  1370.   FProviderEOF := Value;
  1371.   if Assigned(FCloneSource) then
  1372.     FCloneSource.ProviderEOF := Value;
  1373. end;
  1374.  
  1375. function TClientDataSet.GetProviderEOF: Boolean;
  1376. begin
  1377.   if Assigned(FCloneSource) then
  1378.     FProviderEOF := FCloneSource.ProviderEOF;
  1379.   Result := FProviderEOF;
  1380. end;
  1381.  
  1382. function TClientDataSet.GetRemoteServer: TCustomRemoteServer;
  1383. begin
  1384.   Result := FRemoteServer;
  1385. end;
  1386.  
  1387. procedure TClientDataSet.SetRemoteServer(Value: TCustomRemoteServer);
  1388. begin
  1389.   if Value = FRemoteServer then Exit;
  1390.   AppServer := nil;
  1391.   if Assigned(FRemoteServer) then FRemoteServer.UnRegisterClient(Self);
  1392.   if Assigned(Value) then
  1393.   begin
  1394.     CheckInactive;
  1395.     Value.RegisterClient(Self);
  1396.     ClearSavedPacket;
  1397.     Value.FreeNotification(Self);
  1398.   end;
  1399.   FRemoteServer := Value;
  1400. end;
  1401.  
  1402. procedure TClientDataSet.Notification(AComponent: TComponent; Operation: TOperation);
  1403. begin
  1404.   inherited Notification(AComponent, Operation);
  1405.   if (Operation = opRemove) and (AComponent = RemoteServer) then
  1406.     RemoteServer := nil;
  1407.   if (Operation = opRemove) and (AComponent = FCloneSource) then
  1408.   begin
  1409.     FProviderEOF := FCloneSource.ProviderEOF;
  1410.     FCloneSource := nil;
  1411.   end;
  1412. end;
  1413.  
  1414. procedure TClientDataSet.DataEvent(Event: TDataEvent; Info: Integer);
  1415. begin
  1416.   case Event of
  1417.     deParentScroll: MasterChanged(Self);
  1418.     deDataSetScroll,
  1419.     deDataSetChange: SetAltRecBuffers(nil, nil, nil);
  1420.     deFieldListChange: FAggFieldsInit := False;
  1421.     deConnectChange:
  1422.       if not Bool(Info) then
  1423.         AppServer := nil;
  1424.   end;
  1425.   inherited;
  1426. end;
  1427.  
  1428. function TClientDataSet.GetDelta: OleVariant;
  1429. var
  1430.   FDeltaDS: IDSBase;
  1431.   TempPacket: TDataPacket;
  1432. begin
  1433.   CheckBrowseMode;
  1434.   Check(FDSBase.GetDelta(FDeltaDS));
  1435.   FreeDataPacket(FDeltaPacket);
  1436.   Check(FDeltaDS.StreamDS(FDeltaPacket));
  1437.   SafeArrayCopy(FDeltaPacket, TempPacket);
  1438.   DataPacketToVariant(TempPacket, Result);
  1439. end;
  1440.  
  1441. procedure TClientDataSet.Execute;
  1442. begin
  1443.   DoExecute(PackageParams(Params));
  1444. end;
  1445.  
  1446. function TClientDataSet.DataRequest(Data: OleVariant): OleVariant;
  1447. begin
  1448.   Result := AppServer.AS_DataRequest(ProviderName, Data);
  1449. end;
  1450.  
  1451. function TClientDataSet.ApplyUpdates(MaxErrors: Integer): Integer;
  1452. begin
  1453.   CheckBrowseMode;
  1454.   if ChangeCount = 0 then
  1455.     Result := 0 else
  1456.     Reconcile(DoApplyUpdates(Delta, MaxErrors, Result));
  1457. end;
  1458.  
  1459. procedure TClientDataSet.MergeChangeLog;
  1460. begin
  1461.   CheckBrowseMode;
  1462.   FDSBase.AcceptChanges;
  1463. end;
  1464.  
  1465. procedure TClientDataSet.SetAltRecBuffers(Old, New, Cur: PChar);
  1466. begin
  1467.   FOldValueBuffer := Old;
  1468.   FNewValueBuffer := New;
  1469.   FCurValueBuffer := Cur;
  1470. end;
  1471.  
  1472. function TClientDataSet.ReconcileCallback(
  1473.     iRslt         : Integer;   { Previous error if any }
  1474.     iUpdateKind   : DSAttr;    { Update request Insert/Modify/Delete }
  1475.     iResAction    : dsCBRType; { Resolver response }
  1476.     iErrCode      : Integer;   { Native error-code, (BDE or ..) }
  1477.     pErrMessage,               { Native errormessage, if any (otherwise Null) }
  1478.     pErrContext   : PChar;     { 1-level error context, if any (otherwise Null) }
  1479.     pRecUpd,                   { Record that failed update }
  1480.     pRecOrg,                   { Original record, if any }
  1481.     pRecConflict  : Pointer;   { Conflicting error, if any }
  1482.     iLevels       : Integer;   { Number of levels to error0level }
  1483.     piFieldIDs    : PInteger   { Array of fieldIDS to navigate to error-dataset }
  1484. ): dsCBRType;
  1485. var
  1486.   I: Integer;
  1487.   Action: TReconcileAction;
  1488.   UpdateKind: TUpdateKind;
  1489.   DataSet: TClientDataSet;
  1490.   E: EReconcileError;
  1491. begin
  1492.   FInReconcileCallback := True;
  1493.   try
  1494.     if iUpdateKind = dsRecDeleted then
  1495.       UpdateKind := ukDelete
  1496.     else if iUpdateKind = dsRecNew then
  1497.       UpdateKind := ukInsert
  1498.     else
  1499.       UpdateKind := ukModify;
  1500.     if iResAction = dscbrSkip then
  1501.       Action := raSkip else
  1502.       Action := raAbort;
  1503.     FReconcileDataSet.First;
  1504.     E := EReconcileError.Create(pErrMessage, pErrContext, iErrCode, iRslt);
  1505.     try
  1506.       DataSet := FReconcileDataSet;
  1507.       for I := 1 to iLevels do
  1508.       begin
  1509.          DataSet := TClientDataSet((DataSet.Fields.FieldByNumber(piFieldIDs^) as TDataSetField).NestedDataSet);
  1510.          inc(piFieldIDs);
  1511.       end;
  1512.       if UpdateKind = ukDelete then
  1513.         DataSet.SetAltRecBuffers(pRecUpd, pRecOrg, pRecConflict) else
  1514.         DataSet.SetAltRecBuffers(pRecOrg, pRecUpd, pRecConflict);
  1515.       FOnReconcileError(DataSet, E, UpdateKind, Action);
  1516.     finally
  1517.       E.Free;
  1518.     end;
  1519.   except
  1520.     Application.HandleException(Self);
  1521.     Action := raAbort;
  1522.   end;
  1523.   Result := Ord(Action) + 1;
  1524.   FInReconcileCallback := False;
  1525. end;
  1526.  
  1527. function TClientDataSet.Reconcile(const Results: OleVariant): Boolean;
  1528. var
  1529.   RCB: Pointer;
  1530. begin
  1531.   if VarIsNull(Results) then MergeChangeLog else
  1532.   begin
  1533.     UpdateCursorPos;
  1534.     if Assigned(FOnReconcileError) then
  1535.       RCB := @TClientDataSet.ReconcileCallback else
  1536.       RCB := nil;
  1537.     FReconcileDataSet := TClientDataSet.Create(Self);
  1538.     try
  1539.       Check(FDSBase.Clone(0, True, False, FReconcileDataSet.FDSBase));
  1540.       FReconcileDataSet.ObjectView := True;
  1541.       FReconcileDataSet.Open;
  1542.       Check(FDSBase.Reconcile_MD(FReconcileDataSet.FDSBase, FDeltaPacket,
  1543.         VarToDataPacket(Results), Integer(Self), RCB));
  1544.     finally
  1545.       FReconcileDataSet.Free;
  1546.       FReconcileDataSet := nil;
  1547.     end;
  1548.     Resync([]);
  1549.   end;
  1550.   Result := (ChangeCount = 0);
  1551. end;
  1552.  
  1553. procedure TClientDataSet.NotifyCallback;
  1554. begin
  1555.   try
  1556.     if State = dsBrowse then
  1557.     begin
  1558.       UpdateCursorPos;
  1559.       Resync([]);
  1560.     end;
  1561.   except
  1562.   end;
  1563. end;
  1564.  
  1565. procedure TClientDataSet.SetNotifyCallback;
  1566. begin
  1567.   if not FNotifyCallback then
  1568.   begin
  1569.     Check(FDSCursor.SetNotifyCallBack(Integer(Self), @TClientDataSet.NotifyCallback));
  1570.     FNotifyCallback := True;
  1571.   end;
  1572. end;
  1573.  
  1574. procedure TClientDataSet.CloneCursor(Source: TClientDataSet; Reset, KeepSettings: Boolean);
  1575. begin
  1576.   Source.CheckActive;
  1577.   Close;
  1578.   FDSBase := Source.DSBase;
  1579.   Source.UpdateCursorPos;
  1580.   FCloneSource := Source;
  1581.   FParentDataSet := Source.FParentDataSet;
  1582.   if Reset then
  1583.   begin
  1584.     Filtered := False;
  1585.     Filter := '';
  1586.     OnFilterRecord := nil;
  1587.     IndexName := '';
  1588.     MasterSource := nil;
  1589.     MasterFields := '';
  1590.     ReadOnly := False;
  1591.     RemoteServer := nil;
  1592.     ProviderName := '';
  1593.     AppServer := nil;
  1594.   end else
  1595.   if not KeepSettings then
  1596.   begin
  1597.     Filter := Source.Filter;
  1598.     OnFilterRecord := Source.OnFilterRecord;
  1599.     FilterOptions := Source.FilterOptions;
  1600.     Filtered := Source.Filtered;
  1601.     if Source.IndexName <> '' then
  1602.       IndexName := Source.IndexName else
  1603.       IndexFieldNames := Source.IndexFieldNames;
  1604.     MasterSource := Source.MasterSource;
  1605.     MasterFields := Source.MasterFields;
  1606.     ReadOnly := Source.ReadOnly;
  1607.     RemoteServer := Source.RemoteServer;
  1608.     ProviderName := Source.ProviderName;
  1609.     if Source.HasAppServer then
  1610.       AppServer := Source.AppServer;
  1611.   end;
  1612.   Open;
  1613.   if Reset then
  1614.   begin
  1615.     if Source.FExprFilter <> nil then FDSCursor.DropFilter(Source.FExprFilter);
  1616.     if Source.FFuncFilter <> nil then FDSCursor.DropFilter(Source.FFuncFilter);
  1617.     Resync([]);
  1618.   end;
  1619.   SetNotifyCallback;
  1620.   Source.SetNotifyCallback;
  1621. end;
  1622.  
  1623. procedure TClientDataSet.EncodeFieldDesc(var FieldDesc: DSFLDDesc;
  1624.   const Name: string; DataType: TFieldType; Size, Precision: Integer;
  1625.   Calculated: Boolean; Attributes: TFieldAttributes);
  1626. begin
  1627.   with FieldDesc do
  1628.   begin
  1629.     FillChar(FieldDesc, SizeOf(FieldDesc), #0);
  1630.     StrCopy(szName, PChar(Name));
  1631.     iFldType := FieldTypeMap[DataType];
  1632.     iFldSubType := FldSubTypeMap[DataType];
  1633.     bCalculated := Calculated;
  1634.     iFldAttr := Integer(Byte(Attributes));
  1635.     case DataType of
  1636.       ftADT, ftArray, ftDataSet, ftString, ftFixedChar, ftGUID, ftBytes,
  1637.       ftVarBytes, ftBlob..ftTypedBinary, ftOraClob, ftOraBlob, ftWideString:
  1638.         iUnits1 := Size;
  1639.       ftBCD:
  1640.         begin
  1641.           { Default precision is 32, Size = Scale }
  1642.           if (Precision > 0) and (Precision <= 32) then
  1643.             iUnits1 := Precision else
  1644.             iUnits1 := 32;
  1645.           iUnits2 := Size;  {Scale}
  1646.         end;
  1647.     end;
  1648.   end;
  1649. end;
  1650.  
  1651. procedure TClientDataSet.CreateDataSet;
  1652.  
  1653.   procedure GetFieldDefCount(FieldDefs: TFieldDefs; var Count: Integer);
  1654.   var
  1655.     I: Integer;
  1656.   begin
  1657.     Inc(Count, FieldDefs.Count);
  1658.     for I := 0 to FieldDefs.Count - 1 do
  1659.     with FieldDefs[I] do
  1660.       if HasChildDefs then
  1661.         GetFieldDefCount(ChildDefs, Count);
  1662.   end;
  1663.  
  1664.   procedure EncodeFieldDescs(FieldDefs: TFieldDefs; FieldDescs: TFieldDescList;
  1665.     var DescNo: Integer);
  1666.   var
  1667.     I: Integer;
  1668.   begin
  1669.     for I := 0 to FieldDefs.Count - 1 do
  1670.     with FieldDefs[I] do
  1671.     begin
  1672.       EncodeFieldDesc(FieldDescs[DescNo], Name, DataType, Size, Precision, False, Attributes);
  1673.       Inc(DescNo);
  1674.       if HasChildDefs then
  1675.       begin
  1676.         if DataType = ftDataSet then
  1677.           GetFieldDefCount(ChildDefs, FieldDescs[DescNo-1].iUnits2);
  1678.         EncodeFieldDescs(ChildDefs, FieldDescs, DescNo);
  1679.       end;
  1680.     end;
  1681.   end;
  1682.  
  1683.   procedure CreateIndexes;
  1684.   var
  1685.     I: Integer;
  1686.     IndexDesc: DSIdxDesc;
  1687.   begin
  1688.     for I := 0 to IndexDefs.Count - 1 do
  1689.     begin
  1690.       with IndexDefs[I] do
  1691.         EncodeIndexDesc(IndexDesc, Name, Fields, DescFields, CaseInsFields, Options);
  1692.       Check(FDSBase.CreateIndex(IndexDesc));
  1693.     end;
  1694.   end;
  1695.  
  1696. var
  1697.   FieldDefCount, DescNo: Integer;
  1698.   FieldDescs: TFieldDescList;
  1699. begin
  1700.   CheckInactive;
  1701.   InitFieldDefsFromFields;
  1702.   FieldDefCount := 0;
  1703.   GetFieldDefCount(FieldDefs, FieldDefCount);
  1704.   if FieldDefCount = 0 then
  1705.     DatabaseError(SCannotCreateDataSet);
  1706.   SetLength(FieldDescs, FieldDefCount);
  1707.   DescNo := 0;
  1708.   EncodeFieldDescs(FieldDefs, FieldDescs, DescNo);
  1709.   FDSBase := CreateDSBase;
  1710.   try
  1711.     Check(FDSBase.Create(FieldDefCount, pDSFLDDesc(FieldDescs), PChar(Name)));
  1712.     CreateIndexes;
  1713.   except
  1714.     FDSBase := nil;
  1715.     raise;
  1716.   end;
  1717.   Open;
  1718. end;
  1719.  
  1720. procedure TClientDataSet.EmptyDataSet;
  1721. begin
  1722.   CheckBrowseMode;
  1723.   Check(FDSBase.Reset);
  1724.   ProviderEOF := True;
  1725.   Resync([]);
  1726.   InitRecord(ActiveBuffer);
  1727. end;
  1728.  
  1729. procedure TClientDataSet.SetupInternalCalcFields(Add: Boolean);
  1730. var
  1731.   Precision, I: Integer;
  1732.   FieldDesc: DSFLDDesc;
  1733. begin
  1734.   if Add and not DefaultFields then
  1735.   begin
  1736.     for I := 0 to FieldCount - 1 do
  1737.     begin
  1738.       if Fields[I].FieldKind = fkInternalCalc then
  1739.         with Fields[I] do
  1740.         begin
  1741.           if DataType = ftBCD then
  1742.             Precision := TBCDField(Fields[I]).Precision else
  1743.             Precision := 0;
  1744.           EncodeFieldDesc(FieldDesc, FieldName, DataType, Size, Precision, True, []);
  1745.           Check(FDSBase.AddField(@FieldDesc));
  1746.         end;
  1747.     end;
  1748.   end
  1749.   else if InternalCalcFields then
  1750.   begin
  1751.     Check(FDSBase.SetFieldCalculation(0, nil));
  1752.     Check(FDSBase.AddField(nil));
  1753.   end;
  1754. end;
  1755.  
  1756. procedure TClientDataSet.WriteDataPacket(Stream: TStream; WriteSize: Boolean;
  1757.   XMLFormat: Boolean = False);
  1758. var
  1759.   Size: Integer;
  1760.   DataPtr: Pointer;
  1761. begin
  1762.   RCS;
  1763.   if Active then CheckBrowseMode;
  1764.   if IsCursorOpen then
  1765.   begin
  1766.     CheckProviderEOF;
  1767.     SaveDataPacket(XMLFormat);
  1768.   end;
  1769.   if Assigned(FSavedPacket) then
  1770.   begin
  1771.     Size := DataPacketSize(FSavedPacket);
  1772.     SafeArrayAccessData(FSavedPacket, DataPtr);
  1773.     try
  1774.       if WriteSize then
  1775.         Stream.Write(Size, SizeOf(Size));
  1776.       Stream.Write(DataPtr^, Size);
  1777.     finally
  1778.       SafeArrayUnAccessData(FSavedPacket);
  1779.     end;
  1780.     if Active then ClearSavedPacket;
  1781.   end;
  1782. end;
  1783.  
  1784. procedure TClientDataSet.ReadDataPacket(Stream: TStream; ReadSize: Boolean);
  1785. var
  1786.   Size: Integer;
  1787.   DataPtr: Pointer;
  1788.   VarBound: TVarArrayBound;
  1789. begin
  1790.   RCS;
  1791.   if ReadSize then
  1792.     Stream.ReadBuffer(Size, SizeOf(Size)) else
  1793.     Size := Stream.Size - Stream.Position;
  1794.   if Size > 0 then
  1795.   begin
  1796.     ClearSavedPacket;
  1797.     FillChar(VarBound, SizeOf(VarBound), 0);
  1798.     VarBound.ElementCount := Size;
  1799.     FSavedPacket := TDataPacket(SafeArrayCreate(varByte, 1, VarBound));
  1800.     try
  1801.       SafeArrayAccessData(FSavedPacket, DataPtr);
  1802.       try
  1803.         Stream.Read(DataPtr^, Size);
  1804.       finally
  1805.         SafeArrayUnAccessData(FSavedPacket);
  1806.       end;
  1807.     except
  1808.       ClearSavedPacket;
  1809.       raise;
  1810.     end;
  1811.   end;
  1812. end;
  1813.  
  1814. procedure TClientDataSet.LoadFromStream(Stream: TStream);
  1815. begin
  1816.   Close;
  1817.   ReadDataPacket(Stream, False);
  1818.   Open;
  1819. end;
  1820.  
  1821. procedure TClientDataSet.SaveToStream(Stream: TStream; Format: TDataPacketFormat = dfBinary);
  1822. begin
  1823.   WriteDataPacket(Stream, False, (Format=dfXML));
  1824. end;
  1825.  
  1826. procedure TClientDataSet.LoadFromFile(const FileName: string = '');
  1827. var
  1828.   Stream: TStream;
  1829. begin
  1830.   Close;
  1831.   if FileName = '' then
  1832.     Stream := TFileStream.Create(Self.FileName, fmOpenRead) else
  1833.     Stream := TFileStream.Create(FileName, fmOpenRead);
  1834.   try
  1835.     FOpeningFile := True;
  1836.     try
  1837.       LoadFromStream(Stream);
  1838.     finally
  1839.       FOpeningFile := False;
  1840.     end;
  1841.   finally
  1842.     Stream.Free;
  1843.   end;
  1844. end;
  1845.  
  1846. procedure TClientDataSet.SaveToFile(const FileName: string = '';
  1847.   Format: TDataPacketFormat = dfBinary);
  1848. var
  1849.   Stream: TStream;
  1850. begin
  1851.   if FileName = '' then
  1852.     Stream := TFileStream.Create(Self.FileName, fmCreate) else
  1853.     Stream := TFileStream.Create(FileName, fmCreate);
  1854.   try
  1855.     if LowerCase(ExtractFileExt(FileName)) = '.xml' then
  1856.       Format := dfXML;
  1857.     SaveToStream(Stream, Format);
  1858.   finally
  1859.     Stream.Free;
  1860.   end;
  1861. end;
  1862.  
  1863. procedure TClientDataSet.SetLogChanges(Value: Boolean);
  1864. begin
  1865.   CheckBrowseMode;
  1866.   Check(FDSBase.SetProp(dspropLOGCHANGES, Integer(Value)));
  1867. end;
  1868.  
  1869. function TClientDataSet.GetLogChanges: Boolean;
  1870. var
  1871.   LogChanges: Integer;
  1872. begin
  1873.   CheckBrowseMode;
  1874.   Check(FDSBase.GetProp(dspropLOGCHANGES, @LogChanges));
  1875.   Result := Boolean(LogChanges);
  1876. end;
  1877.  
  1878. function TClientDataSet.GetCanModify: Boolean;
  1879. begin
  1880.   Result := FCanModify and not ReadOnly;
  1881. end;
  1882.  
  1883. procedure TClientDataSet.SetReadOnly(Value: Boolean);
  1884. begin
  1885.   FReadOnly := Value;
  1886.   if Assigned(FDSBase) then
  1887.   begin
  1888.     Check(FDSBase.SetProp(dspropREADONLY, Integer(Value)));
  1889.     FCanModify := not Value;
  1890.   end;
  1891. end;
  1892.  
  1893. function TClientDataSet.ConstraintsDisabled: Boolean;
  1894. begin
  1895.   Result := FConstDisableCount > 0;
  1896. end;
  1897.  
  1898. procedure TClientDataSet.DisableConstraints;
  1899. begin
  1900.   if FConstDisableCount = 0 then
  1901.     Check(FDSBase.SetProp(dspropCONSTRAINTS_DISABLED, Longint(True)));
  1902.   Inc(FConstDisableCount);
  1903. end;
  1904.  
  1905. procedure TClientDataSet.EnableConstraints;
  1906. begin
  1907.   if FConstDisableCount <> 0 then
  1908.   begin
  1909.     Dec(FConstDisableCount);
  1910.     if FConstDisableCount = 0 then
  1911.       Check(FDSBase.SetProp(dspropCONSTRAINTS_DISABLED, Longint(False)));
  1912.   end;
  1913. end;
  1914.  
  1915. { Record Functions }
  1916.  
  1917. procedure TClientDataSet.InitBufferPointers(GetProps: Boolean);
  1918. var
  1919.   CursorProps: DSProps;
  1920. begin
  1921.   if GetProps then
  1922.   begin
  1923.     Check(FDSCursor.GetCursorProps(CursorProps));
  1924.     BookmarkSize := CursorProps.iBookmarkSize;
  1925.     SetLength(FLastParentBM, BookMarkSize);
  1926.     FRecordSize := CursorProps.iRecBufSize;
  1927.   end;
  1928.   FRecInfoOfs := FRecordSize + CalcFieldsSize;
  1929.   FBookmarkOfs := FRecInfoOfs + SizeOf(TRecInfo);
  1930.   FAggGrpIndOfs := FBookmarkOfs + BookMarkSize;
  1931.   FAggFieldsOfs := FAggGrpIndOfs + FAggGrpIndSize;
  1932.   FRecBufSize := FAggFieldsOfs + FAggFieldsSize;
  1933. end;
  1934.  
  1935. function TClientDataSet.AllocRecordBuffer: PChar;
  1936. begin
  1937.   Result := AllocMem(FRecBufSize);
  1938. end;
  1939.  
  1940. procedure TClientDataSet.FreeRecordBuffer(var Buffer: PChar);
  1941. begin
  1942.   FreeMem(Buffer);
  1943. end;
  1944.  
  1945. procedure TClientDataSet.InternalInitRecord(Buffer: PChar);
  1946. begin
  1947.   Check(FDSCursor.InitRecord(Buffer));
  1948. end;
  1949.  
  1950. procedure TClientDataSet.ClearCalcFields(Buffer: PChar);
  1951. begin
  1952.   FillChar(Buffer[RecordSize], CalcFieldsSize, 0);
  1953. end;
  1954.  
  1955. procedure TClientDataSet.InitRecord(Buffer: PChar);
  1956. begin
  1957.   inherited InitRecord(Buffer);
  1958.   with PRecInfo(Buffer + FRecInfoOfs)^ do
  1959.   begin
  1960.     BookMarkFlag := bfInserted;
  1961.     RecordNumber := -1;
  1962.     Attribute := dsRecNew;
  1963.   end;
  1964. end;
  1965.  
  1966. function TClientDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
  1967.   DoCheck: Boolean): TGetResult;
  1968. var
  1969.   Status: DBResult;
  1970. begin
  1971.   with FDSCursor do
  1972.   begin
  1973.     case GetMode of
  1974.       gmNext:
  1975.         begin
  1976.           Status := MoveRelative(1);
  1977.           if (Status = DBERR_EOF) and not ProviderEOF and FFetchOnDemand then
  1978.           begin
  1979.             MoveRelative(-1);
  1980.             FetchMoreData(False);
  1981.             Status := MoveRelative(1);
  1982.           end;
  1983.         end;
  1984.       gmPrior: Status := MoveRelative(-1);
  1985.     else
  1986.       Status := DBERR_NONE;
  1987.     end;
  1988.     if Status = DBERR_NONE then
  1989.       Status := GetCurrentRecord(Buffer);
  1990.     case Status of
  1991.       DBERR_NONE:
  1992.         begin
  1993.           if (AggFields.Count > 0) and AggregatesActive then
  1994.             GetAggFieldData(Buffer);
  1995.           with PRecInfo(Buffer + FRecInfoOfs)^ do
  1996.           begin
  1997.             BookmarkFlag := bfCurrent;
  1998.             GetSequenceNumber(DWord(RecordNumber));
  1999.             GetRecordAttribute(Attribute);
  2000.           end;
  2001.           GetCalcFields(Buffer);
  2002.           Check(GetCurrentBookmark(Buffer + FBookmarkOfs));
  2003.           Result := grOK;
  2004.         end;
  2005.       DBERR_BOF: Result := grBOF;
  2006.       DBERR_EOF: Result := grEOF;
  2007.     else
  2008.       Result := grError;
  2009.       if DoCheck then Check(Status);
  2010.     end;
  2011.   end;
  2012. end;
  2013.  
  2014. function TClientDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
  2015. begin
  2016.   if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
  2017.   begin
  2018.     UpdateCursorPos;
  2019.     Result := (FDSCursor.GetCurrentRecord(Buffer) = DBERR_NONE);
  2020.   end else
  2021.     Result := False;
  2022. end;
  2023.  
  2024. function TClientDataSet.GetRecordCount: Integer;
  2025. var
  2026.   Status: DBResult;
  2027. begin
  2028.   CheckActive;
  2029.   if FParentDataSet <> nil then
  2030.     FParentDataSet.UpdateCursorPos;
  2031.   Status := FDSCursor.GetRecordCount(Result);
  2032.   if Status <> DBERR_DETAILSNOTFETCHED then
  2033.     Check(Status);
  2034. end;
  2035.  
  2036. function TClientDataSet.GetRecNo: Integer;
  2037. var
  2038.   BufPtr: PChar;
  2039. begin
  2040.   CheckActive;
  2041.   if State = dsInternalCalc then
  2042.     Result := -1
  2043.   else
  2044.   begin
  2045.     if State = dsCalcFields then
  2046.       BufPtr := CalcBuffer else
  2047.       BufPtr := ActiveBuffer;
  2048.     Result := PRecInfo(BufPtr + FRecInfoOfs).RecordNumber;
  2049.   end;
  2050. end;
  2051.  
  2052. procedure TClientDataSet.SetRecNo(Value: Integer);
  2053. begin
  2054.   CheckBrowseMode;
  2055.   if Value <> RecNo then
  2056.   begin
  2057.     DoBeforeScroll;
  2058.     Check(FDSCursor.MoveToSeqNo(Value));
  2059.     Resync([rmCenter]);
  2060.     DoAfterScroll;
  2061.   end;
  2062. end;
  2063.  
  2064. function TClientDataSet.GetRecordSize: Word;
  2065. begin
  2066.   Result := FRecordSize;
  2067. end;
  2068.  
  2069. function TClientDataSet.GetActiveRecBuf(var RecBuf: PChar): Boolean;
  2070.  
  2071.   function GetOriginalBuffer: PChar;
  2072.   begin
  2073.     UpdateCursorPos;
  2074.     Result := TempBuffer;
  2075.     if FDSCursor.GetProp(curpropGETORG_RECBUF, Result) <> DBERR_NONE then
  2076.       Result := nil;
  2077.   end;
  2078.  
  2079. begin
  2080.   case State of
  2081.     dsBlockRead,
  2082.     dsBrowse: if IsEmpty then RecBuf := nil else RecBuf := ActiveBuffer;
  2083.     dsEdit, dsInsert: RecBuf := ActiveBuffer;
  2084.     dsSetKey: RecBuf := PChar(FKeyBuffer) + SizeOf(TKeyBuffer);
  2085.     dsCalcFields,
  2086.     dsInternalCalc: RecBuf := CalcBuffer;
  2087.     dsFilter: RecBuf := FFilterBuffer;
  2088.     dsNewValue: RecBuf := FNewValueBuffer;
  2089.     dsOldValue: if FOldValueBuffer <> nil then
  2090.                   RecBuf := FOldValueBuffer else
  2091.                   RecBuf := GetOriginalBuffer;
  2092.     dsCurValue: RecBuf := FCurValueBuffer;
  2093.     dsInActive: RecBuf := nil;
  2094.   else
  2095.     RecBuf := nil;
  2096.   end;
  2097.   Result := RecBuf <> nil;
  2098. end;
  2099.  
  2100. function TClientDataSet.GetChangeCount: Integer;
  2101. begin
  2102.   if Active then
  2103.     Check(FDSBase.GetProp(dspropNOOFCHANGES, @Result)) else
  2104.     Result := 0;
  2105. end;
  2106.  
  2107. function TClientDataSet.UpdateStatus: TUpdateStatus;
  2108. var
  2109.   BufPtr: PChar;
  2110.   Attr: Byte;
  2111. begin
  2112.   CheckActive;
  2113.   if State = dsInternalCalc then
  2114.     Result := usUnModified
  2115.   else
  2116.   begin
  2117.     if State = dsCalcFields then
  2118.       BufPtr := CalcBuffer else
  2119.       BufPtr := ActiveBuffer;
  2120.     Attr := PRecInfo(BufPtr + FRecInfoOfs).Attribute;
  2121.     if (Attr and dsRecModified) <> 0 then
  2122.       Result := usModified
  2123.     else if (Attr and dsRecDeleted) <> 0 then
  2124.       Result := usDeleted
  2125.     else if (Attr and dsRecNew) <> 0 then
  2126.       Result := usInserted
  2127.     else
  2128.       Result := usUnModified;
  2129.   end;
  2130. end;
  2131.  
  2132. { Field Related }
  2133.  
  2134. procedure TClientDataSet.AddFieldDesc(FieldDescs: TFieldDescList;
  2135.   var DescNo: Integer; var FieldID: Integer; FieldDefs: TFieldDefs);
  2136. var
  2137.   FPrecision, I: Integer;
  2138.   FType: TFieldType;
  2139.   FSize: Integer;
  2140.   FName: string;
  2141.   FieldDesc: DSFLDDesc;
  2142. begin
  2143.   FieldDesc := FieldDescs[DescNo];
  2144.   Inc(DescNo);
  2145.   with FieldDesc do
  2146.   begin
  2147.     if ((fldAttrLINK and iFldAttr) <> 0) then
  2148.     begin
  2149.       Inc(FieldID);
  2150.       Exit;
  2151.     end;
  2152.     FName := szName;
  2153.     I := 0;
  2154.     while FieldDefs.IndexOf(FName) >= 0 do
  2155.     begin
  2156.       Inc(I);
  2157.       FName := Format('%s_%d', [szName, I]);
  2158.     end;
  2159.     if iFldType < MAXLOGFLDTYPES then
  2160.       FType := DataTypeMap[iFldType] else
  2161.     if iFldType = fldUNICODE then
  2162.       FType := ftWideString else
  2163.       FType := ftUnknown;
  2164.     FSize := 0;
  2165.     FPrecision := 0;
  2166.     case iFldType of
  2167.       fldZSTRING, fldBYTES, fldVARBYTES, fldADT, fldArray:
  2168.       begin
  2169.         FSize := iUnits1;
  2170.         if iFldSubType = fldstGuid then
  2171.           FType := ftGuid;
  2172.       end;
  2173.       fldUNICODE:
  2174.         FSize := iUnits1 div 2;
  2175.       fldINT16, fldUINT16:
  2176.         if iFldLen <> 2 then FType := ftUnknown;
  2177.       fldINT32:
  2178.         if iFldSubType = fldstAUTOINC then FType := ftAutoInc;
  2179.       fldFLOAT:
  2180.         if iFldSubType = fldstMONEY then FType := ftCurrency;
  2181.       fldBCD:
  2182.         begin
  2183.           FSize := Abs(iUnits2);
  2184.           FPrecision := iUnits1;
  2185.         end;
  2186.       fldBLOB:
  2187.         begin
  2188.           FSize := iUnits1;
  2189.           if ( (iFldSubType >= fldstMEMO) and (iFldSubType <= fldstTYPEDBINARY))
  2190.               or (iFldSubType = fldstHMEMO ) or ( iFldSubType = fldstHBINARY) then
  2191.             FType := BlobTypeMap[iFldSubType];
  2192.         end;
  2193.       fldTABLE:
  2194.         if iFldSubType = fldstREFERENCE then FType := ftReference;
  2195.     end;
  2196.     if FType <> ftUnknown then
  2197.       with FieldDefs.AddFieldDef do
  2198.       begin
  2199.         FieldNo := FieldID;
  2200.         Inc(FieldID);
  2201.         Name := FName;
  2202.         DataType := FType;
  2203.         Size := FSize;
  2204.         Precision := FPrecision;
  2205.         Attributes := TFieldAttributes(Byte(iFldAttr));
  2206.         if iFldSubType = fldstFIXED then
  2207.           Attributes := Attributes + [faFixed];
  2208.         InternalCalcField := bCalculated;
  2209.         case FType of
  2210.           ftADT:
  2211.             for I := 0 to iUnits1 - 1 do
  2212.               AddFieldDesc(FieldDescs, DescNo, FieldID, ChildDefs);
  2213.           ftArray:
  2214.             begin
  2215.               I := FieldID;
  2216.               AddFieldDesc(FieldDescs, DescNo, I, ChildDefs);
  2217.               Inc(FieldID, iUnits2);
  2218.             end;
  2219.         end; { case }
  2220.       end;
  2221.   end;
  2222. end;
  2223.  
  2224. function TClientDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  2225. var
  2226.   IsBlank: LongBool;
  2227.   RecBuf: PChar;
  2228. begin
  2229.   Result := False;
  2230.   if GetActiveRecBuf(RecBuf) then
  2231.     with Field do
  2232.       if FieldKind in [fkData, fkInternalCalc] then
  2233.       begin
  2234.         Check(FDSCursor.GetField(RecBuf, FieldNo, Buffer, IsBlank));
  2235.         Result := not IsBlank;
  2236.       end else
  2237.         if State in [dsBrowse, dsEdit, dsInsert, dsCalcFields] then
  2238.         begin
  2239.           Inc(RecBuf, FRecordSize + Offset);
  2240.           Result := Boolean(RecBuf[0]);
  2241.           if Result and (Buffer <> nil) then
  2242.             Move(RecBuf[1], Buffer^, DataSize);
  2243.         end;
  2244. end;
  2245.  
  2246. function TClientDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; 
  2247. var
  2248.   RecBuf: PChar;
  2249.   IsBlank: LongBool;
  2250. begin
  2251.   Result := GetActiveRecBuf(RecBuf);
  2252.   if Result then
  2253.   begin
  2254.     Check(FDSCursor.GetFIeld(RecBuf, FieldNo, Buffer, IsBlank));
  2255.     Result := not IsBlank;
  2256.   end;
  2257. end;
  2258.  
  2259. function TClientDataSet.GetStateFieldValue(State: TDataSetState; Field: TField): Variant;
  2260.  
  2261.   function CheckNotChanged(Buffer: PChar): Variant;
  2262.   var
  2263.     IsBlank: Integer;
  2264.   begin
  2265.     if (Buffer = nil) then
  2266.       IsBlank := BLANK_NOTCHANGED else
  2267.       Check(FDSCursor.GetField(Buffer, Field.FieldNo, nil, LongBool(IsBlank)));
  2268.     if IsBlank = BLANK_NOTCHANGED then
  2269.       Result := UnAssigned
  2270.     else if IsBlank =  BLANK_NULL then
  2271.       Result := Null else
  2272.       Result := inherited GetStateFieldValue(State, Field);
  2273.   end;
  2274.  
  2275. begin
  2276.   case State of
  2277.     dsNewValue:
  2278.       if FNewValueBuffer = nil then
  2279.       begin
  2280.         FNewValueBuffer := ActiveBuffer;
  2281.         try
  2282.           Result := CheckNotChanged(FNewValueBuffer);
  2283.         finally
  2284.           FNewValueBuffer := nil;
  2285.         end;
  2286.       end else
  2287.         Result := CheckNotChanged(FNewValueBuffer);
  2288.     dsCurValue: Result := CheckNotChanged(FCurValueBuffer);
  2289.   else
  2290.     Result := inherited GetStateFieldValue(State, Field);
  2291.   end;
  2292. end;
  2293.  
  2294. procedure TClientDataSet.SetFieldData(Field: TField; Buffer: Pointer);
  2295. var
  2296.   RecBuf: PChar;
  2297. begin
  2298.   with Field do
  2299.   begin
  2300.     if not (State in dsWriteModes) then DatabaseError(SNotEditing, Self);
  2301.     if (State = dsSetKey) and ((FieldNo < 0) or (FIndexFieldCount > 0) and
  2302.       not IsIndexField) then DatabaseErrorFmt(SNotIndexField, [DisplayName]);
  2303.     GetActiveRecBuf(RecBuf);
  2304.     if FieldKind in [fkData, fkInternalCalc] then
  2305.     begin
  2306.       if ReadOnly and not (State in [dsSetKey, dsFilter]) then
  2307.         DatabaseErrorFmt(SFieldReadOnly, [DisplayName]);
  2308.       Validate(Buffer);
  2309.       if State in [dsEdit, dsInsert] then
  2310.         Check(FDSCursor.VerifyField(FieldNo, Buffer));
  2311.       Check(FDSCursor.PutField(RecBuf, FieldNo, Buffer));
  2312.       if FAggFieldsUpdated <> nil then
  2313.         FAggFieldsUpdated[FieldNo-1] := True;
  2314.     end else
  2315.     begin
  2316.       if State = dsInternalCalc then Exit;
  2317.       Inc(RecBuf, FRecordSize + Offset);
  2318.       Boolean(RecBuf[0]) := LongBool(Buffer);
  2319.       if Boolean(RecBuf[0]) then Move(Buffer^, RecBuf[1], DataSize);
  2320.     end;
  2321.     if not (State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
  2322.       DataEvent(deFieldChange, Longint(Field));
  2323.   end;
  2324. end;
  2325.  
  2326. function TClientDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  2327. var
  2328.   Status: DBResult;
  2329.   BlobLen: DWord;
  2330.   Buffer: PChar;
  2331. begin
  2332.   if GetActiveRecBuf(Buffer) then
  2333.   begin
  2334.     Status := FDSCursor.GetBlobLen(Buffer, Field.FieldNo, BlobLen);
  2335.     if (Status = DBERR_BLOBNOTFETCHED) and FetchOnDemand then
  2336.       FetchBlobs;
  2337.   end;
  2338.   Result := TClientBlobStream.Create(Field as TBlobField, Mode);
  2339. end;
  2340.  
  2341. procedure TClientDataSet.RefreshInternalCalcFields(Buffer: PChar);
  2342. begin
  2343.   CalculateFields(Buffer);
  2344. end;
  2345.  
  2346. function TClientDataSet.CalcFieldsCallBack(RecBuf: PChar): DBResult;
  2347. var
  2348.   SaveState: TDataSetState;
  2349. begin
  2350.   if State <> dsInactive then
  2351.     try
  2352.       SaveState := SetTempState(dsInternalCalc);
  2353.       try
  2354.         CalculateFields(RecBuf);
  2355.       finally
  2356.         RestoreState(SaveState);
  2357.       end;
  2358.     except
  2359.     end;
  2360.   Result := 0;
  2361. end;
  2362.  
  2363. procedure TClientDataSet.DataConvert(Field: TField; Source, Dest: Pointer;
  2364.   ToNative: Boolean);
  2365. begin
  2366.   if Field.DataType = ftWideString then
  2367.   begin
  2368.     if ToNative then
  2369.     begin
  2370.       Word(Dest^) := Length(PWideString(Source)^)*2;
  2371.       Move(PWideChar(Source^)^, (PWideChar(Dest)+1)^, Word(Dest^));
  2372.     end else
  2373.       PWideChar(Dest^) := SysAllocStringLen(PWideChar(PChar(Source)+2), Word(Source^) div 2);
  2374.   end else
  2375.     inherited;
  2376. end;
  2377.  
  2378. { Navigation / Editing }
  2379.  
  2380. procedure TClientDataSet.InternalFirst;
  2381. begin
  2382.   Check(FDSCursor.MoveToBOF);
  2383. end;
  2384.  
  2385. procedure TClientDataSet.InternalLast;
  2386. begin
  2387.   CheckProviderEOF;
  2388.   Check(FDSCursor.MoveToEOF);
  2389. end;
  2390.  
  2391. procedure TClientDataSet.InternalPost;
  2392. begin
  2393.   if State = dsEdit then
  2394.     Check(FDSCursor.ModifyRecord(ActiveBuffer)) else
  2395.     Check(FDSCursor.InsertRecord(ActiveBuffer));
  2396.   if AggregatesActive then
  2397.     DoAggUpdates(State = dsEdit);
  2398. end;
  2399.  
  2400. procedure TClientDataSet.InternalCancel;
  2401. begin
  2402.   if BlobFieldCount > 0 then
  2403.     FDSBase.ReleaseBlobs(0);
  2404. end;
  2405.  
  2406. procedure TClientDataSet.InternalDelete;
  2407. begin
  2408.   if doDisableDeletes in FDSOptions then
  2409.     DatabaseError(SNoDeletesAllowed, Self);
  2410.   Check(DSCursor.DeleteRecord);
  2411.   if AggregatesActive then
  2412.     DoAggUpdates(False);
  2413. end;
  2414.  
  2415. procedure TClientDataSet.InternalEdit;
  2416. begin
  2417.   if doDisableEdits in FDSOptions then
  2418.     DatabaseError(SNoEditsAllowed, Self);
  2419. end;
  2420.  
  2421. procedure TClientDataSet.DoBeforeInsert;
  2422. begin
  2423.   if doDisableInserts in FDSOptions then
  2424.     DatabaseError(SNoInsertsAllowed, Self);
  2425.   inherited DoBeforeInsert;
  2426.   if (DataSetField <> nil) then
  2427.   begin
  2428.     { Force inserted master to post before allowing insert on nested dataset }
  2429.     if DataSetField.DataSet.State = dsInsert then
  2430.       DataSetField.DataSet.Post;
  2431.   end;
  2432. end;
  2433.  
  2434. procedure TClientDataSet.InternalInsert;
  2435. begin
  2436.   DSCursor.SetProp(curpropSETCRACK, 0);
  2437.   CursorPosChanged;
  2438. end;
  2439.  
  2440. procedure TClientDataSet.Post;
  2441. var
  2442.   CursorProps: DSProps;
  2443. begin
  2444.   Check(FDSBase.GetProps(CursorProps));
  2445.   if CursorProps.bDelta and (State in [dsEdit, dsInsert]) then
  2446.   begin
  2447.     UpdateRecord;
  2448.     InternalPost;
  2449.     SetState(dsBrowse);
  2450.   end else
  2451.   begin
  2452.     inherited Post;
  2453.     if State = dsSetKey then
  2454.       PostKeyBuffer(True);
  2455.   end;
  2456. end;
  2457.  
  2458. procedure TClientDataSet.Cancel;
  2459. begin
  2460.   inherited Cancel;
  2461.   if State = dsSetKey then
  2462.     PostKeyBuffer(False);
  2463. end;
  2464.  
  2465. procedure TClientDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
  2466. begin
  2467.   if Append then FDSCursor.MoveToEOF;
  2468.   Check(FDSCursor.InsertRecord(Buffer));
  2469. end;
  2470.  
  2471. procedure TClientDataSet.InternalGotoBookmark(Bookmark: TBookmark);
  2472. begin
  2473.   Check(FDSCursor.MoveToBookmark(Bookmark));
  2474. end;
  2475.  
  2476. procedure TClientDataSet.InternalSetToRecord(Buffer: PChar);
  2477. begin
  2478.   InternalGotoBookmark(Buffer + FBookmarkOfs);
  2479. end;
  2480.  
  2481. function TClientDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  2482. begin
  2483.   Result := PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag;
  2484. end;
  2485.  
  2486. procedure TClientDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  2487. begin
  2488.   PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag := Value;
  2489. end;
  2490.  
  2491. procedure TClientDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
  2492. begin
  2493.   Move(Buffer[FBookmarkOfs], Data^, BookmarkSize);
  2494. end;
  2495.  
  2496. procedure TClientDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
  2497. begin
  2498.   Move(Data^, ActiveBuffer[FBookmarkOfs], BookmarkSize);
  2499. end;
  2500.  
  2501. function TClientDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  2502. const
  2503.   RetCodes: array[Boolean, Boolean] of ShortInt = ((2, -1),(1, 0));
  2504. begin
  2505.   { Check for uninitialized bookmarks }
  2506.   Result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
  2507.   if Result = 2 then
  2508.   begin
  2509.     Check(FDSCursor.CompareBookmarks(Bookmark1, Bookmark2, Result));
  2510.     if Result = 2 then Result := 0;
  2511.   end;
  2512. end;
  2513.  
  2514. function TClientDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
  2515. begin
  2516.   Result := FDSCursor <> nil;
  2517.   if Result then
  2518.   begin
  2519.     CursorPosChanged;
  2520.     Result := (FDSCursor.MoveToBookmark(Bookmark) = DBERR_NONE) and
  2521.       (FDSCursor.GetCurrentRecord(nil) = DBERR_NONE);
  2522.   end;
  2523. end;
  2524.  
  2525. procedure TClientDataSet.SyncCursors(Cursor1, Cursor2: IDSCursor);
  2526. var
  2527.   BM: DSBOOKMRK;
  2528. begin
  2529.   Cursor2.GetCurrentBookmark(@BM);
  2530.   Cursor1.MoveToBookmark(@BM);
  2531. end;
  2532.  
  2533. function TClientDataSet.UndoLastChange(FollowChange: Boolean): Boolean;
  2534. begin
  2535.   Cancel;
  2536.   CheckBrowseMode;
  2537.   UpdateCursorPos;
  2538.   Result := (FDSCursor.UndoLastChange(FollowChange) = DBERR_NONE);
  2539.   if Result then
  2540.   begin
  2541.     if FollowChange then CursorPosChanged;
  2542.     Resync([]);
  2543.   end;
  2544. end;
  2545.  
  2546. procedure TClientDataSet.RevertRecord;
  2547. begin
  2548.   Cancel;
  2549.   CheckBrowseMode;
  2550.   UpdateCursorPos;
  2551.   Check(FDSCursor.RevertRecord);
  2552.   Resync([]);
  2553. end;
  2554.  
  2555. function TClientDataSet.GetSavePoint: Integer;
  2556. begin
  2557.   CheckBrowseMode;
  2558.   FDSBase.GetProp(dspropGETSAVEPOINT, @Result);
  2559. end;
  2560.  
  2561. procedure TClientDataSet.SetSavePoint(Value: Integer);
  2562. begin
  2563.   Cancel;
  2564.   CheckBrowseMode;
  2565.   UpdateCursorPos;
  2566.   Check(FDSBase.RollBack(Value));
  2567.   CursorPosChanged;
  2568.   Resync([]);
  2569. end;
  2570.  
  2571. procedure TClientDataSet.CancelUpdates;
  2572. begin
  2573.   SetSavePoint(0);
  2574. end;
  2575.  
  2576. { Indexes }
  2577.  
  2578. procedure TClientDataSet.UpdateIndexDefs;
  2579. var
  2580.   I: Integer;
  2581.   CursorProps: DSProps;
  2582.   IndexDescs: array of DSIDXDesc;
  2583.   Opts: TIndexOptions;
  2584.   IdxName, Flds: string;
  2585.   DescFlds, CaseInsFlds: string;
  2586. begin
  2587.   if (csDesigning in ComponentState) and (IndexDefs.Count > 0) then Exit;
  2588.   if Active and not IndexDefs.Updated then
  2589.   begin
  2590.     FieldDefs.Update;
  2591.     Check(FDSCursor.GetCursorProps(CursorProps));
  2592.     SetLength(IndexDescs, CursorProps.iIndexes);
  2593.     IndexDefs.Clear;
  2594.     Check(FDSBase.GetIndexDescs(PDSIDXDesc(IndexDescs)));
  2595.     for I := 0 to CursorProps.iIndexes - 1 do
  2596.     begin
  2597.       DecodeIndexDesc(IndexDescs[I], IdxName, Flds, DescFlds, CaseInsFlds, Opts);
  2598.       with IndexDefs.AddIndexDef do
  2599.       begin
  2600.         Name := IdxName;
  2601.         Fields := Flds;
  2602.         DescFields := DescFlds;
  2603.         CaseInsFields := CaseInsFlds;
  2604.         Options := Opts;
  2605.       end;
  2606.     end;
  2607.     IndexDefs.Updated := True;
  2608.   end;
  2609. end;
  2610.  
  2611. procedure TClientDataSet.DecodeIndexDesc(const IndexDesc: DSIDXDesc;
  2612.   var Name, Fields, DescFields, CaseInsFields: string; var Options: TIndexOptions);
  2613.  
  2614.   procedure ConcatField(var FieldList: string; const FieldName: string);
  2615.   begin
  2616.     if FieldList = '' then
  2617.       FieldList := FieldName else
  2618.       FieldList := Format('%s;%s', [FieldList, FieldName]);
  2619.   end;
  2620.  
  2621.   procedure CheckOption(const FieldList: string; var OptionFields: string;
  2622.     Option: TIndexOption);
  2623.   begin
  2624.     if (FieldList <> '') and (OptionFields = FieldList) then
  2625.     begin
  2626.       Include(Options, Option);
  2627.       OptionFields := '';
  2628.     end;
  2629.   end;
  2630.  
  2631.  
  2632. var
  2633.   I: Integer;
  2634.   FieldName: string;
  2635. begin
  2636.   FieldDefList.Update;
  2637.   with IndexDesc do
  2638.   begin
  2639.     Name := szName;
  2640.     Fields := '';
  2641.     DescFields := '';
  2642.     CaseInsFields := '';
  2643.     for I := 0 to iFields - 1 do
  2644.     begin
  2645.       if iKeyFields[I] <= FieldDefList.Count then
  2646.       begin
  2647.         FieldName := FieldDefList.Strings[iKeyFields[I] - 1];
  2648.         ConcatField(Fields, FieldName);
  2649.       end else
  2650.         FieldName := '';
  2651.       if bDescending[I] then
  2652.         ConcatField(DescFields, FieldName);
  2653.       if bCaseInsensitive[I] then
  2654.         ConcatField(CaseInsFields, FieldName);
  2655.     end;
  2656.     Options := [];
  2657.     if bUnique then Include(Options, ixUnique);
  2658.     CheckOption(Fields, DescFields, ixDescending);
  2659.     CheckOption(Fields, CaseInsFields, ixCaseInsensitive);
  2660.   end;
  2661. end;
  2662.  
  2663. procedure TClientDataSet.GetIndexNames(List: TStrings);
  2664. begin
  2665.   IndexDefs.Update;
  2666.   IndexDefs.GetItemNames(List);
  2667. end;
  2668.  
  2669. function TClientDataSet.GetIndexDefs: TIndexDefs;
  2670. begin
  2671.   if FIndexDefs = nil then
  2672.     FIndexDefs := TIndexDefs.Create(Self);
  2673.   Result := FIndexDefs;
  2674. end;
  2675.  
  2676. procedure TClientDataSet.SetIndexDefs(Value: TIndexDefs);
  2677. begin
  2678.   IndexDefs.Assign(Value);
  2679. end;
  2680.  
  2681. procedure TClientDataSet.GetIndexInfo(IndexName: string);
  2682. var
  2683.   Index: Integer;
  2684.   IndexDesc: DSIDXDesc;
  2685. begin
  2686.   if FDSCursor.GetIndexDescs(True, IndexDesc) = 0 then
  2687.   begin
  2688.     FIndexFieldCount := IndexDesc.iFields;
  2689.     FIndexFieldMap := IndexDesc.iKeyFields;
  2690.     FKeySize := IndexDesc.iKeyLen;
  2691.   end;
  2692.   Index := IndexDefs.IndexOf(IndexName);
  2693.   if Index <> -1 then
  2694.     FIndexGroupingLevel := IndexDefs[Index].GroupingLevel else
  2695.     FIndexGroupingLevel := 0;
  2696. end;
  2697.  
  2698. procedure TClientDataSet.SwitchToIndex(const IndexName: string);
  2699. var
  2700.   Status: DBResult;
  2701.   IndexDesc: DSIDXDesc;
  2702. begin
  2703.   ResetCursorRange;
  2704.   Status := FDSCursor.UseIndexOrder(PChar(IndexName));
  2705.   if Status <> DBERR_NONE then
  2706.   begin
  2707.     if Status = DBERR_NOSUCHINDEX then
  2708.     begin
  2709.       with IndexDefs.Find(IndexName) do
  2710.       begin
  2711.         EncodeIndexDesc(IndexDesc, Name, Fields, DescFields, CaseInsFields, Options);
  2712.         Check(FDSBase.CreateIndex(IndexDesc));
  2713.         Check(FDSCursor.UseIndexOrder(PChar(IndexName)));
  2714.       end;
  2715.     end else
  2716.       Check(Status);
  2717.   end;
  2718.   GetIndexInfo(IndexName);
  2719. end;
  2720.  
  2721. procedure TClientDataSet.SetIndex(const Value: string; FieldsIndex: Boolean);
  2722. begin
  2723.   if Active then
  2724.   begin
  2725.     CheckBrowseMode;
  2726.     UpdateCursorPos;
  2727.     CheckProviderEOF;
  2728.     if (FIndexName <> Value) or (FFieldsIndex <> FieldsIndex) then
  2729.     begin
  2730.       if FieldsIndex then
  2731.         SortOnFields(FDSCursor, Value, False, False) else
  2732.         SwitchToIndex(Value);
  2733.       FIndexName := Value;
  2734.       FFieldsIndex := FieldsIndex;
  2735.       if FAggregatesActive then
  2736.       begin
  2737.         FAggFieldsInit := False;
  2738.         ResetAllAggs(FAggregatesActive);
  2739.         SetBufListSize(0);
  2740.         InitBufferPointers(True);
  2741.         try
  2742.           SetBufListSize(BufferCount + 1);
  2743.         except
  2744.           SetState(dsInactive);
  2745.           CloseCursor;
  2746.           raise;
  2747.         end;
  2748.       end;
  2749.       ResetCursorRange;
  2750.       CheckMasterRange;
  2751.       Resync([]);
  2752.     end;
  2753.   end;
  2754.   FIndexName := Value;
  2755.   FFieldsIndex := FieldsIndex;
  2756. end;
  2757.  
  2758. procedure TClientDataSet.EncodeIndexDesc(var IndexDesc: DSIDXDesc;
  2759.   const Name, Fields, DescFields, CaseInsFields: string; Options: TIndexOptions);
  2760.  
  2761.   function IndexFieldOfs(const FieldName: string): Integer;
  2762.   var
  2763.     FieldNo: Integer;
  2764.   begin
  2765.     FieldNo := FieldDefs.Find(FieldName).FieldNo;
  2766.     for Result := 0 to IndexDesc.iFields - 1 do
  2767.       if IndexDesc.iKeyfields[Result] = FieldNo then Exit;
  2768.     DatabaseErrorFmt(SIndexFieldMissing, [FieldName], Self);
  2769.     Result := -1;
  2770.   end;
  2771.  
  2772. var
  2773.   Pos: Integer;
  2774.   Descending,
  2775.   CaseInsensitive: Bool;
  2776. begin
  2777.   FillChar(IndexDesc, SizeOf(IndexDesc), 0);
  2778.   with IndexDesc do
  2779.   begin
  2780.     StrCopy(szName, PChar(Name));
  2781.     bUnique := ixUnique in Options;
  2782.     Descending := (ixDescending in Options) and (DescFields = '');
  2783.     CaseInsensitive := (ixCaseInsensitive in Options) and (CaseInsFields = '');
  2784.     Pos := 1;
  2785.     while (Pos <= Length(Fields)) and (iFields < MAXKEYFIELDS) do
  2786.     begin
  2787.       iKeyFields[iFields] :=
  2788.         FieldDefList.FieldByName(ExtractFieldName(Fields, Pos)).FieldNo;
  2789.       bDescending[iFields] := Descending;
  2790.       bCaseInsensitive[iFields] := CaseInsensitive;
  2791.       Inc(iFields);
  2792.     end;
  2793.     Pos := 1;
  2794.     while Pos <= Length(DescFields) do
  2795.       bDescending[IndexFieldOfs(ExtractFieldName(DescFields, Pos))] := True;
  2796.     Pos := 1;
  2797.     while Pos <= Length(CaseInsFields) do
  2798.       bCaseInsensitive[IndexFieldOfs(ExtractFieldName(CaseInsFields, Pos))] := True;
  2799.   end;
  2800. end;
  2801.  
  2802. procedure TClientDataSet.AddIndex(const Name, Fields: string;
  2803.   Options: TIndexOptions; const DescFields, CaseInsFields: string;
  2804.   const GroupingLevel: Integer);
  2805. var
  2806.   IndexDesc: DSIDXDesc;
  2807.   IndexDef: TIndexDef;
  2808. begin
  2809.   CheckBrowseMode;
  2810.   FieldDefs.Update;
  2811.   EncodeIndexDesc(IndexDesc, Name, Fields, DescFields, CaseInsFields, Options);
  2812.   CursorPosChanged;
  2813.   Check(FDSBase.CreateIndex(IndexDesc));
  2814.   if GroupingLevel > 0 then
  2815.   begin
  2816.     IndexDefs.Update;
  2817.     IndexDef := IndexDefs.Find(Name);
  2818.     if IndexDef <> nil then
  2819.       IndexDef.GroupingLevel := GroupingLevel;
  2820.   end
  2821.   else
  2822.     IndexDefs.Updated := False;
  2823. end;
  2824.  
  2825. procedure TClientDataSet.DeleteIndex(const Name: string);
  2826. begin
  2827.   CheckBrowseMode;
  2828.   if AnsiCompareText(Name, IndexName) = 0 then IndexName := '';
  2829.   Check(FDSBase.RemoveIndex(PChar(Name)));
  2830.   IndexDefs.Updated := False;
  2831. end;
  2832.  
  2833. function TClientDataSet.GetIndexField(Index: Integer): TField;
  2834. var
  2835.   FieldNo: Integer;
  2836. begin
  2837.   if (Index < 0) or (Index >= FIndexFieldCount) then
  2838.     DatabaseError(SFieldIndexError, Self);
  2839.   FieldNo := FIndexFieldMap[Index];
  2840.   Result := FieldByNumber(FieldNo);
  2841.   if Result = nil then
  2842.     DatabaseErrorFmt(SIndexFieldMissing, [FieldDefs[FieldNo - 1].Name], Self);
  2843. end;
  2844.  
  2845. function TClientDataSet.GetIsIndexField(Field: TField): Boolean;
  2846. var
  2847.   I: Integer;
  2848. begin
  2849.   Result := False;
  2850.   with Field do
  2851.     if FieldNo > 0 then
  2852.       for I := 0 to FIndexFieldCount - 1 do
  2853.         if FIndexFieldMap[I] = FieldNo then
  2854.         begin
  2855.           Result := True;
  2856.           Exit;
  2857.         end;
  2858. end;
  2859.  
  2860. function TClientDataSet.GetIndexName: string;
  2861. begin
  2862.   if FFieldsIndex then Result := '' else Result := FIndexName;
  2863. end;
  2864.  
  2865. procedure TClientDataSet.SetIndexName(const Value: string);
  2866. begin
  2867.   SetIndex(Value, False);
  2868. end;
  2869.  
  2870. procedure TClientDataSet.SetIndexField(Index: Integer; Value: TField);
  2871. begin
  2872.   GetIndexField(Index).Assign(Value);
  2873. end;
  2874.  
  2875. function TClientDataSet.GetIndexFieldNames: string;
  2876. begin
  2877.   if FFieldsIndex then Result := FIndexName else Result := '';
  2878. end;
  2879.  
  2880. procedure TClientDataSet.SetIndexFieldNames(const Value: string);
  2881. begin
  2882.   SetIndex(Value, Value <> '');
  2883. end;
  2884.  
  2885. function TClientDataSet.GetIndexFieldCount: Integer;
  2886. begin
  2887.   Result := FIndexFieldCount;
  2888. end;
  2889.  
  2890. procedure TClientDataSet.SortOnFields(Cursor: IDSCursor; const Fields: string;
  2891.   CaseInsensitive, Descending: Boolean);
  2892. var
  2893.   I: Integer;
  2894.   FieldList: TList;
  2895.   DescFlags, CaseFlags: DSKEYBOOL;
  2896.  
  2897.   function GetFlags(Flag: Bool; var FlagArray: DSKEYBOOL): Pointer;
  2898.   var
  2899.     J: Integer;
  2900.   begin
  2901.     if not Flag then Result := nil else
  2902.     begin
  2903.       for J := 0 to FieldList.Count - 1 do
  2904.         FlagArray[J] := True;
  2905.       Result := @FlagArray;
  2906.     end;
  2907.   end;
  2908.  
  2909. begin
  2910.   FieldList := TList.Create;
  2911.   try
  2912.     GetFieldList(FieldList, Fields);
  2913.     for I := 0 to FieldList.Count - 1 do
  2914.       if TField(FieldList[I]).FieldNo > 0 then
  2915.         FieldList[I] := Pointer(TField(FieldList[I]).FieldNo) else
  2916.         DatabaseError(SFieldIndexError, Self);
  2917.     Check(Cursor.SortOnFields(FieldList.Count, PDWord(FieldList.List),
  2918.       GetFlags(Descending, DescFlags), GetFlags(CaseInsensitive, CaseFlags)));
  2919.     GetIndexInfo('');
  2920.   finally
  2921.     FieldList.Free;
  2922.   end;
  2923. end;
  2924.  
  2925. { Ranges / Keys }
  2926.  
  2927. procedure TClientDataSet.AllocKeyBuffers;
  2928. var
  2929.   KeyIndex: TKeyIndex;
  2930. begin
  2931.   try
  2932.     for KeyIndex := Low(TKeyIndex) to High(TKeyIndex) do
  2933.       FKeyBuffers[KeyIndex] := AllocMem(SizeOf(TKeyBuffer) + FRecordSize);
  2934.     if Assigned(FCloneSource) then
  2935.       for KeyIndex := Low(TKeyIndex) to High(TKeyIndex) do
  2936.         Move(FCloneSource.FKeyBuffers[KeyIndex]^, FKeyBuffers[KeyIndex]^,
  2937.           SizeOf(TKeyBuffer) + FRecordSize);
  2938.   except
  2939.     FreeKeyBuffers;
  2940.     raise;
  2941.   end;
  2942. end;
  2943.  
  2944. function TClientDataSet.GetKeyBuffer(KeyIndex: TKeyIndex): PKeyBuffer;
  2945. begin
  2946.   Result := FKeyBuffers[KeyIndex];
  2947. end;
  2948.  
  2949. procedure TClientDataSet.FreeKeyBuffers;
  2950. var
  2951.   KeyIndex: TKeyIndex;
  2952. begin
  2953.   for KeyIndex := Low(TKeyIndex) to High(TKeyIndex) do
  2954.     DisposeMem(FKeyBuffers[KeyIndex], SizeOf(TKeyBuffer) + FRecordSize);
  2955. end;
  2956.  
  2957. function TClientDataSet.InitKeyBuffer(Buffer: PKeyBuffer): PKeyBuffer;
  2958. begin
  2959.   FillChar(Buffer^, SizeOf(TKeyBuffer) + FRecordSize, 0);
  2960.   Check(FDSCursor.InitRecord(PChar(Buffer) + SizeOf(TKeyBuffer)));
  2961.   Result := Buffer;
  2962. end;
  2963.  
  2964. procedure TClientDataSet.CheckSetKeyMode;
  2965. begin
  2966.   if State <> dsSetKey then DatabaseError(SNotEditing, Self);
  2967. end;
  2968.  
  2969. function TClientDataSet.SetCursorRange: Boolean;
  2970. var
  2971.   RangeStart, RangeEnd: PKeyBuffer;
  2972.   StartKey, EndKey: PChar;
  2973. begin
  2974.   Result := False;
  2975.   if not (
  2976.     BuffersEqual(FKeyBuffers[kiRangeStart], FKeyBuffers[kiCurRangeStart],
  2977.     SizeOf(TKeyBuffer) + FRecordSize) and
  2978.     BuffersEqual(FKeyBuffers[kiRangeEnd], FKeyBuffers[kiCurRangeEnd],
  2979.     SizeOf(TKeyBuffer) + FRecordSize)) then
  2980.   begin
  2981.     CheckProviderEOF;
  2982.     RangeStart := FKeyBuffers[kiRangeStart];
  2983.     RangeEnd := FKeyBuffers[kiRangeEnd];
  2984.     StartKey := PChar(RangeStart) + SizeOf(TKeyBuffer);
  2985.     if not RangeStart.Modified then
  2986.       StartKey := nil;
  2987.     EndKey := PChar(RangeEnd) + SizeOf(TKeyBuffer);
  2988.     if not RangeEnd.Modified then
  2989.       EndKey := nil;
  2990.     Check(FDSCursor.SetRange(RangeStart.FieldCount, StartKey,
  2991.       not RangeStart.Exclusive, EndKey, not RangeEnd.Exclusive));
  2992.     Move(FKeyBuffers[kiRangeStart]^, FKeyBuffers[kiCurRangeStart]^,
  2993.       SizeOf(TKeyBuffer) + FRecordSize);
  2994.     Move(FKeyBuffers[kiRangeEnd]^, FKeyBuffers[kiCurRangeEnd]^,
  2995.       SizeOf(TKeyBuffer) + FRecordSize);
  2996.     DestroyLookupCursor;
  2997.     Result := True;
  2998.   end;
  2999. end;
  3000.  
  3001. function TClientDataSet.ResetCursorRange: Boolean;
  3002. begin
  3003.   Result := False;
  3004.   if FKeyBuffers[kiCurRangeStart].Modified or
  3005.     FKeyBuffers[kiCurRangeEnd].Modified then
  3006.   begin
  3007.     Check(FDSCursor.DropRange);
  3008.     InitKeyBuffer(FKeyBuffers[kiCurRangeStart]);
  3009.     InitKeyBuffer(FKeyBuffers[kiCurRangeEnd]);
  3010.     DestroyLookupCursor;
  3011.     Result := True;
  3012.   end;
  3013. end;
  3014.  
  3015. procedure TClientDataSet.SetLinkRanges(MasterFields: TList);
  3016. var
  3017.   I: Integer;
  3018.   SaveState: TDataSetState;
  3019. begin
  3020.   SaveState := SetTempState(dsSetKey);
  3021.   try
  3022.     FKeyBuffer := InitKeyBuffer(FKeyBuffers[kiRangeStart]);
  3023.     FKeyBuffer^.Modified := True;
  3024.     for I := 0 to MasterFields.Count - 1 do
  3025.       GetIndexField(I).Assign(TField(MasterFields[I]));
  3026.     FKeyBuffer^.FieldCount := MasterFields.Count;
  3027.   finally
  3028.     RestoreState(SaveState);
  3029.   end;
  3030.   Move(FKeyBuffers[kiRangeStart]^, FKeyBuffers[kiRangeEnd]^,
  3031.     SizeOf(TKeyBuffer) + FRecordSize);
  3032. end;
  3033.  
  3034. procedure TClientDataSet.SetKeyBuffer(KeyIndex: TKeyIndex; Clear: Boolean);
  3035. begin
  3036.   CheckBrowseMode;
  3037.   FKeyBuffer := FKeyBuffers[KeyIndex];
  3038.   Move(FKeyBuffer^, FKeyBuffers[kiSave]^, SizeOf(TKeyBuffer) + FRecordSize);
  3039.   if Clear then InitKeyBuffer(FKeyBuffer);
  3040.   SetState(dsSetKey);
  3041.   SetModified(FKeyBuffer.Modified);
  3042.   DataEvent(deDataSetChange, 0);
  3043. end;
  3044.  
  3045. procedure TClientDataSet.PostKeyBuffer(Commit: Boolean);
  3046. begin
  3047.   DataEvent(deCheckBrowseMode, 0);
  3048.   if Commit then
  3049.     FKeyBuffer.Modified := Modified else
  3050.     Move(FKeyBuffers[kiSave]^, FKeyBuffer^, SizeOf(TKeyBuffer) + FRecordSize);
  3051.   SetState(dsBrowse);
  3052.   DataEvent(deDataSetChange, 0);
  3053. end;
  3054.  
  3055. function TClientDataSet.GetKeyExclusive: Boolean;
  3056. begin
  3057.   CheckSetKeyMode;
  3058.   Result := FKeyBuffer.Exclusive;
  3059. end;
  3060.  
  3061. procedure TClientDataSet.SetKeyExclusive(Value: Boolean);
  3062. begin
  3063.   CheckSetKeyMode;
  3064.   FKeyBuffer.Exclusive := Value;
  3065. end;
  3066.  
  3067. function TClientDataSet.GetKeyFieldCount: Integer;
  3068. begin
  3069.   CheckSetKeyMode;
  3070.   Result := FKeyBuffer.FieldCount;
  3071. end;
  3072.  
  3073. procedure TClientDataSet.SetKeyFieldCount(Value: Integer);
  3074. begin
  3075.   CheckSetKeyMode;
  3076.   FKeyBuffer.FieldCount := Value;
  3077. end;
  3078.  
  3079. procedure TClientDataSet.SetKeyFields(KeyIndex: TKeyIndex;
  3080.   const Values: array of const);
  3081. var
  3082.   I: Integer;
  3083.   SaveState: TDataSetState;
  3084. begin
  3085.   DoBeforeScroll;
  3086.   if FIndexFieldCount = 0 then DatabaseError(SNoFieldIndexes, Self);
  3087.   SaveState := SetTempState(dsSetKey);
  3088.   try
  3089.     FKeyBuffer := InitKeyBuffer(FKeyBuffers[KeyIndex]);
  3090.     if FParentDataSet = nil then
  3091.     begin
  3092.       for I := 0 to High(Values) do GetIndexField(I).AssignValue(Values[I]);
  3093.       FKeyBuffer^.FieldCount := High(Values) + 1;
  3094.     end else
  3095.     begin
  3096.       { Skip the linking field for nested datasets }
  3097.       for I := 0 to High(Values) do GetIndexField(I+1).AssignValue(Values[I]);
  3098.       FKeyBuffer^.FieldCount := High(Values);
  3099.     end;
  3100.     FKeyBuffer^.Modified := Modified;
  3101.   finally
  3102.     RestoreState(SaveState);
  3103.   end;
  3104.   DoAfterScroll;
  3105. end;
  3106.  
  3107. function TClientDataSet.FindKey(const KeyValues: array of const): Boolean;
  3108. begin
  3109.   CheckBrowseMode;
  3110.   SetKeyFields(kiLookup, KeyValues);
  3111.   Result := GotoKey;
  3112. end;
  3113.  
  3114. procedure TClientDataSet.FindNearest(const KeyValues: array of const);
  3115. begin
  3116.   CheckBrowseMode;
  3117.   SetKeyFields(kiLookup, KeyValues);
  3118.   GotoNearest
  3119. end;
  3120.  
  3121. function TClientDataSet.GotoKey: Boolean;
  3122. var
  3123.   KeyBuffer: PKeyBuffer;
  3124.   RecBuffer: PChar;
  3125. begin
  3126.   CheckBrowseMode;
  3127.   CursorPosChanged;
  3128.   CheckProviderEOF;
  3129.   KeyBuffer := FKeyBuffers[kiLookup];
  3130.   RecBuffer := PChar(KeyBuffer) + SizeOf(TKeyBuffer);
  3131.   Result := FDSCursor.GetRecordForKey(KeyBuffer.FieldCount, 0, RecBuffer, nil) = 0;
  3132.   if Result then Resync([rmExact, rmCenter]);
  3133. end;
  3134.  
  3135. procedure TClientDataSet.GotoNearest;
  3136. var
  3137.   SearchCond: DBSearchCond;
  3138.   KeyBuffer: PKeyBuffer;
  3139.   RecBuffer: PChar;
  3140. begin
  3141.   CheckBrowseMode;
  3142.   CheckProviderEOF;
  3143.   KeyBuffer := FKeyBuffers[kiLookup];
  3144.   RecBuffer := PChar(KeyBuffer) + SizeOf(TKeyBuffer);
  3145.   if KeyBuffer^.Exclusive then
  3146.     SearchCond := keySEARCHGT else
  3147.     SearchCond := keySEARCHGEQ;
  3148.   Check(FDSCursor.MoveToKey(SearchCond, KeyBuffer.FieldCount, 0, RecBuffer));
  3149.   Resync([rmCenter]);
  3150. end;
  3151.  
  3152. procedure TClientDataSet.SetKey;
  3153. begin
  3154.   SetKeyBuffer(kiLookup, True);
  3155. end;
  3156.  
  3157. procedure TClientDataSet.EditKey;
  3158. begin
  3159.   SetKeyBuffer(kiLookup, False);
  3160. end;
  3161.  
  3162. procedure TClientDataSet.ApplyRange;
  3163. begin
  3164.   CheckBrowseMode;
  3165.   if SetCursorRange then First;
  3166. end;
  3167.  
  3168. procedure TClientDataSet.CancelRange;
  3169. begin
  3170.   CheckBrowseMode;
  3171.   UpdateCursorPos;
  3172.   if ResetCursorRange then Resync([]);
  3173. end;
  3174.  
  3175. procedure TClientDataSet.SetRange(const StartValues, EndValues: array of const);
  3176. begin
  3177.   CheckBrowseMode;
  3178.   SetKeyFields(kiRangeStart, StartValues);
  3179.   SetKeyFields(kiRangeEnd, EndValues);
  3180.   ApplyRange;
  3181. end;
  3182.  
  3183. procedure TClientDataSet.SetRangeEnd;
  3184. begin
  3185.   SetKeyBuffer(kiRangeEnd, True);
  3186. end;
  3187.  
  3188. procedure TClientDataSet.SetRangeStart;
  3189. begin
  3190.   SetKeyBuffer(kiRangeStart, True);
  3191. end;
  3192.  
  3193. procedure TClientDataSet.EditRangeEnd;
  3194. begin
  3195.   SetKeyBuffer(kiRangeEnd, False);
  3196. end;
  3197.  
  3198. procedure TClientDataSet.EditRangeStart;
  3199. begin
  3200.   SetKeyBuffer(kiRangeStart, False);
  3201. end;
  3202.  
  3203. { Master / Detail }
  3204.  
  3205. procedure TClientDataSet.CheckDetailRecords;
  3206. var
  3207.   I, RecCount: Integer;
  3208.   MasterValues: OleVariant;
  3209.   Status: DBResult;
  3210. begin
  3211.   Status := FDSCursor.GetRecordCount(RecCount);
  3212.   if DataSetField <> nil then
  3213.   begin
  3214.     if (Status = DBERR_DETAILSNOTFETCHED) and FetchOnDemand then
  3215.       FParentDataSet.FetchDetails;
  3216.   end else
  3217.   begin
  3218.     if (RecCount = 0) and HasAppServer and not ProviderEOF and
  3219.       (FPacketRecords = 0) and not MasterSource.DataSet.IsEmpty and
  3220.       (MasterSource.DataSet.State <> dsInsert) then
  3221.     begin
  3222.       MasterValues := VarArrayCreate([0, FMasterLink.Fields.Count - 1], varVariant);
  3223.       for I := 0 to FMasterLink.Fields.Count - 1 do
  3224.         with TField(FMasterLink.Fields[I]) do
  3225.           MasterValues[I] := VarArrayOf([IndexFields[I].FieldName, Value]);
  3226.       AddDataPacket(DoGetRecords(-1, RecCount, 0, '', MasterValues), False);
  3227.       if Active then First;
  3228.     end;
  3229.   end;
  3230. end;
  3231.  
  3232. procedure TClientDataSet.CheckMasterRange;
  3233. begin
  3234.   if FMasterLink.Active and (FMasterLink.Fields.Count > 0) then
  3235.   begin
  3236.     SetLinkRanges(FMasterLink.Fields);
  3237.     SetCursorRange;
  3238.     if FetchOnDemand then CheckDetailRecords;
  3239.   end;
  3240. end;
  3241.  
  3242. procedure TClientDataSet.MasterChanged(Sender: TObject);
  3243. begin
  3244.   CheckBrowseMode;
  3245.   if DataSetField = nil then
  3246.   begin
  3247.     SetLinkRanges(FMasterLink.Fields);
  3248.     ApplyRange;
  3249.     if FetchOnDemand then CheckDetailRecords;
  3250.   end else
  3251.   begin
  3252.     if FParentDataSet.State = dsInsert then
  3253.       First
  3254.     else if not CompareMem(FLastParentBM, @FParentDataSet.ActiveBuffer[FParentDataset.FBookmarkOfs], FParentDataSet.BookmarkSize) then
  3255.     begin
  3256.       if FetchOnDemand then CheckDetailRecords;
  3257.       First;
  3258.       Move(FParentDataSet.ActiveBuffer[FParentDataSet.FBookmarkOfs], FLastParentBM[0], FParentDataSet.BookmarkSize);
  3259.     end else
  3260.     begin
  3261.       UpdateCursorPos;
  3262.       Resync([]);
  3263.     end;
  3264.   end;
  3265. end;
  3266.  
  3267. procedure TClientDataSet.MasterDisabled(Sender: TObject);
  3268. begin
  3269.   CancelRange;
  3270. end;
  3271.  
  3272. procedure TClientDataSet.SetDataSetField(const Value: TDataSetField);
  3273. begin
  3274.   if Assigned(Value) then
  3275.   begin
  3276.     Close;
  3277.     ProviderName := '';
  3278.     RemoteServer := nil;
  3279.     FileName := '';
  3280.   end;
  3281.   inherited;
  3282. end;
  3283.  
  3284. procedure TClientDataSet.Loaded;
  3285. begin
  3286.   inherited Loaded;
  3287.   if Active and Assigned(FSavedPacket) then Open;
  3288. end;
  3289.  
  3290. procedure TClientDataSet.ReadData(Stream: TStream);
  3291. begin
  3292.   ReadDataPacket(Stream, True);
  3293. end;
  3294.  
  3295. procedure TClientDataSet.WriteData(Stream: TStream);
  3296. begin
  3297.   WriteDataPacket(Stream, True);
  3298. end;
  3299.  
  3300. function TClientDataSet.GetDataSource: TDataSource;
  3301. begin
  3302.   Result := FMasterLink.DataSource;
  3303. end;
  3304.  
  3305. procedure TClientDataSet.SetDataSource(Value: TDataSource);
  3306. begin
  3307.   if (Value <> nil) and (DataSetField <> nil) then
  3308.     DatabaseError(SNoNestedMasterSource, Self);
  3309.   if IsLinkedTo(Value) then DatabaseError(SCircularDataLink, Self);
  3310.   FMasterLink.DataSource := Value;
  3311.   if not (csDesigning in ComponentState) or
  3312.     (csLoading in ComponentState) then Exit;
  3313.   if Assigned(Value) then
  3314.   begin
  3315.     if FPacketRecords = -1 then FPacketRecords := 0;
  3316.   end else
  3317.   begin
  3318.     if FPacketRecords = 0 then FPacketRecords := -1;
  3319.   end;
  3320. end;
  3321.  
  3322. function TClientDataSet.GetMasterFields: string;
  3323. begin
  3324.   Result := FMasterLink.FieldNames;
  3325. end;
  3326.  
  3327. procedure TClientDataSet.SetMasterFields(const Value: string);
  3328. begin
  3329.   FMasterLink.FieldNames := Value;
  3330. end;
  3331.  
  3332. procedure TClientDataSet.DoOnNewRecord;
  3333. var
  3334.   I: Integer;
  3335. begin
  3336.   if DataSetField = nil then
  3337.     if FMasterLink.Active and (FMasterLink.Fields.Count > 0) then
  3338.       for I := 0 to FMasterLink.Fields.Count - 1 do
  3339.         IndexFields[I] := TField(FMasterLink.Fields[I]);
  3340.   if (AggFields.Count > 0) and AggregatesActive then
  3341.     GetAggFieldData(ActiveBuffer);
  3342.   inherited DoOnNewRecord;
  3343. end;
  3344.  
  3345. procedure TClientDataSet.DefineProperties(Filer: TFiler);
  3346.  
  3347.   function DataStored: Boolean;
  3348.   begin
  3349.     Result := Active and (DataSetField = nil) and not HasAppServer and
  3350.       (ProviderName = '') and (FCloneSource = nil);
  3351.     if Result and Assigned(Filer.Ancestor) then
  3352.       with TClientDataSet(Filer.Ancestor) do
  3353.         Result := not Active or HasAppServer or (ProviderName <> '') or
  3354.           (DataSize <> Self.DataSize);
  3355.   end;
  3356.  
  3357. begin
  3358.   inherited DefineProperties(Filer);
  3359.   Filer.DefineBinaryProperty('Data', ReadData, WriteData, DataStored);
  3360. end;
  3361.  
  3362. { Filters }
  3363.  
  3364. procedure TClientDataSet.ActivateFilters;
  3365. begin
  3366.   if Filter <> '' then
  3367.     AddExprFilter(Filter, FilterOptions);
  3368.   if Assigned(OnFilterRecord) then
  3369.     AddFuncFilter;
  3370. end;
  3371.  
  3372. procedure TClientDataSet.DeactivateFilters;
  3373. begin
  3374.   if FFuncFilter <> nil then
  3375.   begin
  3376.     FDSCursor.DropFilter(FFuncFilter);
  3377.     FFuncFilter := nil;
  3378.   end;
  3379.   if FExprFilter <> nil then
  3380.   begin
  3381.     FDSCursor.DropFilter(FExprFilter);
  3382.     FExprFilter := nil;
  3383.   end;
  3384. end;
  3385.  
  3386. procedure TClientDataSet.AddExprFilter(const Expr: string; Options: TFilterOptions);
  3387. begin
  3388.   if FExprFilter <> nil then FDSCursor.DropFilter(FExprFilter);
  3389.   if Expr <> '' then
  3390.     with TExprParser.Create(Self, Expr, Options, [poExtSyntax], '', nil, FieldTypeMap) do
  3391.     try
  3392.       CheckProviderEOF;
  3393.       Check(FDSCursor.AddFilter(FilterData, DataSize, FExprFilter));
  3394.     finally
  3395.       Free;
  3396.     end;
  3397. end;
  3398.  
  3399. function TClientDataSet.FilterCallback(RecBuf: PChar): Bool;
  3400. var
  3401.   SaveState: TDataSetState;
  3402.   Accept: Boolean;
  3403. begin
  3404.   SaveState := SetTempState(dsFilter);
  3405.   FFilterBuffer := RecBuf;
  3406.   try
  3407.     Accept := True;
  3408.     OnFilterRecord(Self, Accept);
  3409.   except
  3410.     Application.HandleException(Self);
  3411.   end;
  3412.   RestoreState(SaveState);
  3413.   Result := Accept;
  3414. end;
  3415.  
  3416. procedure TClientDataSet.AddFuncFilter;
  3417. begin
  3418.   if FFuncFilter <> nil then FDSCursor.DropFilter(FFuncFilter);
  3419.   CheckProviderEOF;
  3420.   Check(FDSCursor.AddFilterCallBack(Integer(Self), @TClientDataSet.FilterCallback,
  3421.     FFuncFilter));
  3422. end;
  3423.  
  3424. procedure TClientDataSet.SetFilterData(const Text: string; Options: TFilterOptions);
  3425. begin
  3426.   if Active and Filtered then
  3427.   begin
  3428.     CheckBrowseMode;
  3429.     if (Filter <> Text) or (FilterOptions <> Options) then
  3430.       AddExprFilter(Text, Options);
  3431.     DestroyLookupCursor;
  3432.     First;
  3433.   end;
  3434.   inherited SetFilterText(Text);
  3435.   inherited SetFilterOptions(Options);
  3436. end;
  3437.  
  3438. procedure TClientDataSet.SetFilterText(const Value: string);
  3439. begin
  3440.   SetFilterData(Value, FilterOptions);
  3441. end;
  3442.  
  3443. procedure TClientDataSet.SetFilterOptions(Value: TFilterOptions);
  3444. begin
  3445.   SetFilterData(Filter, Value);
  3446. end;
  3447.  
  3448. procedure TClientDataSet.SetOnFilterRecord(const Value: TFilterRecordEvent);
  3449. begin
  3450.   if Active and Filtered then
  3451.   begin
  3452.     CheckBrowseMode;
  3453.     if Assigned(OnFilterRecord) <> Assigned(Value) then
  3454.     begin
  3455.       if Assigned(Value) then
  3456.       begin
  3457.         inherited SetOnFilterRecord(Value);
  3458.         AddFuncFilter;
  3459.       end else
  3460.         FDSCursor.DropFilter(FFuncFilter);
  3461.     end;
  3462.     DestroyLookupCursor;
  3463.     First;
  3464.   end;
  3465.   inherited SetOnFilterRecord(Value);
  3466. end;
  3467.  
  3468. procedure TClientDataSet.SetFiltered(Value: Boolean);
  3469. begin
  3470.   if Active then
  3471.   begin
  3472.     CheckBrowseMode;
  3473.     if Filtered <> Value then
  3474.     begin
  3475.       DestroyLookupCursor;
  3476.       FDSCursor.MoveToBOF;
  3477.       if Value then ActivateFilters else DeactivateFilters;
  3478.       inherited SetFiltered(Value);
  3479.     end;
  3480.     First;
  3481.   end else
  3482.     inherited SetFiltered(Value);
  3483. end;
  3484.  
  3485. procedure TClientDataSet.SetStatusFilter(const Value: TUpdateStatusSet);
  3486. var
  3487.   StatusValues: Integer;
  3488. begin
  3489.   CheckBrowseMode;
  3490.   if Value <> [] then
  3491.   begin
  3492.     StatusValues := 0;
  3493.     if usModified in Value then
  3494.       StatusValues := dsRecModified;
  3495.     if usInserted in Value then
  3496.       StatusValues := StatusValues + dsRecNew;
  3497.     if usDeleted in Value then
  3498.       StatusValues := StatusValues + dsRecDeleted;
  3499.     IndexName := szCHANGEINDEX;
  3500.     Check(FDSBase.SetProp(dspropCHANGEINDEX_VIEW, StatusValues));
  3501.   end else
  3502.   begin
  3503.     if IndexName = szCHANGEINDEX then
  3504.       IndexName := szDEFAULT_ORDER;
  3505.     Check(FDSBase.SetProp(dspropCHANGEINDEX_VIEW, 0));
  3506.   end;
  3507.   FStatusFilter := Value;
  3508.   Resync([]);
  3509. end;
  3510.  
  3511. function TClientDataSet.FindRecord(Restart, GoForward: Boolean): Boolean;
  3512. var
  3513.   Status: DBResult;
  3514.   Cursor: IDSCursor;
  3515. begin
  3516.   CheckBrowseMode;
  3517.   SetFound(False);
  3518.   UpdateCursorPos;
  3519.   CursorPosChanged;
  3520.   CheckProviderEOF;
  3521.   DoBeforeScroll;
  3522.   if not Filtered then
  3523.   begin
  3524.     if Restart then FFindCursor := nil;
  3525.     if not Assigned(FFindCursor) then
  3526.     begin
  3527.       ActivateFilters;
  3528.       try
  3529.         FFindCursor := CreateDSCursor(FDSCursor)
  3530.       finally
  3531.         DeactivateFilters;
  3532.       end;
  3533.     end else
  3534.       if not Restart then SyncCursors(FFindCursor, FDSCursor);
  3535.     Cursor := FFindCursor;
  3536.   end else
  3537.     Cursor := FDSCursor;
  3538.   if GoForward then
  3539.   begin
  3540.     if Restart then Check(Cursor.MoveToBOF);
  3541.     Status := Cursor.MoveRelative(1);
  3542.   end else
  3543.   begin
  3544.     if Restart then Check(Cursor.MoveToEOF);
  3545.     Status := Cursor.MoveRelative(-1);
  3546.   end;
  3547.   if Cursor <> FDSCursor then
  3548.   begin
  3549.     SyncCursors(FDSCursor, FFindCursor);
  3550.     Status := FDSCursor.GetCurrentRecord(nil);
  3551.   end;
  3552.   if Status = DBERR_NONE then
  3553.   begin
  3554.     Resync([rmExact, rmCenter]);
  3555.     SetFound(True);
  3556.   end;
  3557.   Result := Found;
  3558.   if Result then DoAfterScroll;
  3559. end;
  3560.  
  3561. procedure TClientDataSet.DestroyLookupCursor;
  3562. begin
  3563.   FFindCursor := nil;
  3564. end;
  3565.  
  3566. function TClientDataSet.LocateRecord(const KeyFields: string;
  3567.   const KeyValues: Variant; Options: TLocateOptions;
  3568.   SyncCursor: Boolean): Boolean;
  3569. var
  3570.   Fields: TList;
  3571.   I: Integer;
  3572.   Status: DBResult;
  3573.   FilterOptions: TFilterOptions;
  3574.   ExprParser: TExprParser;
  3575.   ValStr, Expr: string;
  3576.   Value: Variant;
  3577. begin
  3578.   CheckBrowseMode;
  3579.   CursorPosChanged;
  3580.   CheckProviderEOF;
  3581.   Fields := TList.Create;
  3582.   try
  3583.     GetFieldList(Fields, KeyFields);
  3584.     Expr := '';
  3585.     for i := 0 to Fields.Count - 1 do
  3586.     begin
  3587.       if (Fields.Count = 1) and not VarIsArray(KeyValues) then
  3588.         Value := KeyValues else
  3589.         Value := KeyValues[i];
  3590.       case TField(Fields[i]).DataType of
  3591.         ftString, ftFixedChar, ftWideString, ftGUID:
  3592.           if (i = Fields.Count - 1) and (loPartialKey in Options) then
  3593.             ValStr := Format('''%s*''',[VarToStr(Value)]) else
  3594.             ValStr := Format('''%s''',[VarToStr(Value)]);
  3595.         ftDate, ftTime, ftDateTime:
  3596.           ValStr := Format('''%s''',[VarToStr(Value)]);
  3597.         ftSmallint, ftInteger, ftWord, ftAutoInc, ftBoolean, ftFloat, ftCurrency, ftBCD:
  3598.           ValStr := VarToStr(Value);
  3599.       else
  3600.         DatabaseErrorFmt(SBadFieldType, [TField(Fields[i]).FieldName]);
  3601.       end;
  3602.       if Expr <> '' then
  3603.         Expr := Expr + ' and ';
  3604.       if VarIsNull(Value) then
  3605.         Expr := Expr + Format('[%s] IS NULL',[TField(Fields[i]).FieldName]) 
  3606.       else
  3607.         Expr := Expr + Format('[%s]=%s',[TField(Fields[i]).FieldName, ValStr]);
  3608.     end;
  3609.     FilterOptions := [];
  3610.     if loCaseInsensitive in Options then
  3611.       FilterOptions := [foCaseInsensitive];
  3612.     if not (loPartialKey in Options) then
  3613.       Include(FilterOptions, foNoPartialCompare);
  3614.     ExprParser := TExprParser.Create(Self, Expr, FilterOptions, [], '', nil, FieldTypeMap);
  3615.     try
  3616.       FDSCursor.MoveToBOF;
  3617.       Status := FDSCursor.LocateWithFilter(ExprParser.FilterData, ExprParser.DataSize);
  3618.       if Status = DBERR_NONE then
  3619.         FDSCursor.GetCurrentRecord(TempBuffer);
  3620.     finally
  3621.       ExprParser.Free;
  3622.     end;
  3623.   finally
  3624.     Fields.Free;
  3625.   end;
  3626.   Result := Status = DBERR_NONE;
  3627. end;
  3628.  
  3629. function TClientDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
  3630.   const ResultFields: string): Variant;
  3631. begin
  3632.   Result := Null;
  3633.   if LocateRecord(KeyFields, KeyValues, [], False) then
  3634.   begin
  3635.     SetTempState(dsCalcFields);
  3636.     try
  3637.       CalculateFields(TempBuffer);
  3638.       Result := FieldValues[ResultFields];
  3639.     finally
  3640.       RestoreState(dsBrowse);
  3641.     end;
  3642.   end;
  3643. end;
  3644.  
  3645. function TClientDataSet.Locate(const KeyFields: string;
  3646.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  3647. begin
  3648.   DoBeforeScroll;
  3649.   Result := LocateRecord(KeyFields, KeyValues, Options, True);
  3650.   if Result then
  3651.   begin
  3652.     Resync([rmExact, rmCenter]);
  3653.     DoAfterScroll;
  3654.   end;
  3655. end;
  3656.  
  3657. procedure TClientDataSet.GotoCurrent(DataSet: TClientDataSet);
  3658. begin
  3659.   CheckBrowseMode;
  3660.   CheckProviderEOF;
  3661.   DataSet.CheckActive;
  3662.   BookMark := DataSet.BookMark;
  3663. end;
  3664.  
  3665. { Aggregates }
  3666.  
  3667. function AggValueAsVariant(Agg: TAggregate; Buffer: Pointer): Variant;
  3668. var
  3669.   C: Currency;
  3670. begin
  3671.   case Agg.DataType of
  3672.     ftInteger:
  3673.       Result := LongInt(Buffer^);
  3674.     ftSmallInt:
  3675.       Result := SmallInt(Buffer^);
  3676.     ftBoolean:
  3677.       Result := WordBool(Buffer^);
  3678.     ftFloat:
  3679.       Result := Double(Buffer^);
  3680.     ftBCD:
  3681.       begin
  3682.         BCDToCurr(TBcd(Buffer^), C);
  3683.         Result := C;
  3684.       end;
  3685.     ftDate:
  3686.       Result := VarFromDateTime(TDateTimeRec(Buffer^).Date - DateDelta);
  3687.     ftTime:
  3688.       Result := VarFromDateTime(TDateTimeRec(Buffer^).Time / MSecsPerDay);
  3689.     ftDateTime:
  3690.       Result := VarFromDateTime((TDateTimeRec(Buffer^).DateTime / MSecsPerDay) - DateDelta);
  3691.     ftString, ftGUID:
  3692.       Result := string(PChar(Buffer));
  3693.     ftWideString:
  3694.       with TVarData(Result) do
  3695.       begin
  3696.         VType := varOleStr;
  3697.         VOleStr := SysAllocStringLen(PWideChar(PChar(Buffer)+2), Word(Buffer^) div 2);
  3698.       end;
  3699.     else
  3700.       Result := Null;
  3701.   end;
  3702. end;
  3703.  
  3704. procedure TClientDataSet.SetAggregates(Value: TAggregates);
  3705. begin
  3706.   FAggregates.Assign(Value);
  3707. end;
  3708.  
  3709. procedure TClientDataSet.SetAggsActive(Value: Boolean);
  3710. begin
  3711.   if FAggregatesActive <> Value then
  3712.   begin
  3713.     FAggregatesActive := Value;
  3714.     if FAggregatesActive and Active then
  3715.     begin
  3716.       ResetAllAggs(FAggregatesActive);
  3717.       if AggFields.Count > 0 then
  3718.       begin
  3719.         UpdateCursorPos;
  3720.         Resync([]);
  3721.       end;
  3722.     end;
  3723.   end;
  3724. end;
  3725.  
  3726. procedure TClientDataSet.ClearActiveAggs;
  3727. var
  3728.   I: Integer;
  3729. begin
  3730.   if FActiveAggLists <> nil then
  3731.     for I:= 0 to FActiveAggLists.Count - 1  do
  3732.       if FActiveAggLists[I] <> nil then TList(FActiveAggLists[I]).Free;
  3733.   FActiveAggLists.Clear;
  3734. end;
  3735.  
  3736. procedure TClientDataSet.CloseAggs;
  3737. var
  3738.   I: Integer;
  3739.   Field: TAggregateField;
  3740. begin
  3741.   for I := 0 to FAggregates.Count - 1 do
  3742.     begin
  3743.       if (FAggregates[I].AggHandle <> 0) and (FDSCursor <> nil) then
  3744.         Check(FDSCursor.DropAggregate(FAggregates[I].AggHandle));
  3745.       FAggregates[I].AggHandle := 0;
  3746.     end;
  3747.   for I := 0 to AggFields.Count - 1 do
  3748.   begin
  3749.     Field := AggFields[I] as TAggregateField;
  3750.     if Field.Handle <> nil then
  3751.     begin
  3752.        TAggregate(Field.Handle).Free;
  3753.        Field.Handle := nil;
  3754.     end;
  3755.   end;
  3756.   FAggFieldsInit := False;
  3757. end;
  3758.  
  3759. procedure TClientDataSet.ResetGrouping;
  3760.  
  3761.   function HasAggs(Level: Integer): Boolean;
  3762.   var
  3763.     I: Integer;
  3764.   begin
  3765.     Result := False;
  3766.     for I := 0 to FAggregates.Count - 1 do
  3767.       if TAggregate(FAggregates[I]).GroupingLevel = Level then
  3768.       begin
  3769.         Result := True;
  3770.         Exit;
  3771.       end;
  3772.   end;
  3773.  
  3774. var
  3775.   I: Integer;
  3776.   Agg: TAggregate;
  3777. begin
  3778.   FGroupingLevel := FMaxAggGroupingLevel;
  3779.   if FIndexGroupingLevel > FGroupingLevel then
  3780.     FGroupingLevel := FIndexGroupingLevel;
  3781.   for I:= 1 to FGroupingLevel do
  3782.   begin
  3783.     if not HasAggs(I) then
  3784.     begin
  3785.       Agg := FAggregates.Add;
  3786.       Agg.GroupingLevel := I;
  3787.       Agg.IndexName := FIndexName;
  3788.       Agg.Active := True;
  3789.       Agg.Activate;
  3790.     end;
  3791.   end;
  3792. end;
  3793.  
  3794. procedure TClientDataSet.ResetAgg(Agg: TAggregate; DeleteFirst: Boolean);
  3795. var
  3796.   I, J: Integer;
  3797. begin
  3798.   if DeleteFirst then
  3799.     for I:=0 to FActiveAggLists.Count - 1 do
  3800.     begin
  3801.       J := TList(FActiveAggLists.Items[I]).IndexOf(Agg);
  3802.       if J <> -1 then
  3803.       begin
  3804.         with TList(FActiveAggLists.Items[I]) do
  3805.         begin
  3806.           Delete(J);
  3807.           Pack;
  3808.           Capacity := Count;
  3809.         end;
  3810.         Break;
  3811.       end;
  3812.     end;
  3813.  
  3814.   if Agg.Active and ((AnsiCompareText(Agg.IndexName, FIndexName) = 0)
  3815.      or (Agg.GroupingLevel = 0)) then
  3816.   begin
  3817.     if Agg.DataSet = nil then Agg.FDataSet := Self;
  3818.     Agg.Activate;
  3819.     Agg.FInUse := True;
  3820.     if Agg.GroupingLevel > FMaxAggGroupingLevel then
  3821.       FMaxAggGroupingLevel := Agg.GroupingLevel;
  3822.     while FActiveAggLists.Count <= Agg.GroupingLevel do
  3823.       FActiveAggLists.Add(TList.Create);
  3824.     if Agg.Expression <> '' then
  3825.       TList(FActiveAggLists.Items[Agg.GroupingLevel]).Add(Agg);
  3826.   end else
  3827.   begin
  3828.     Agg.FInUse := False;
  3829.     if Agg.AggHandle <> 0 then
  3830.     begin
  3831.       Check(DSCursor.DropAggregate(Agg.AggHandle));
  3832.       Agg.AggHandle := 0;
  3833.     end
  3834.   end;
  3835.   if FMaxAggGroupingLevel > GroupingLevel then
  3836.     FGroupingLevel := FMaxAggGroupingLevel;
  3837. end;
  3838.  
  3839.  
  3840. procedure TClientDataSet.ResetAllAggs(Value: Boolean);
  3841.  
  3842.   procedure CreateAggsFromAggFields;
  3843.   var
  3844.     I, MaxGrp: Integer;
  3845.     Agg: TAggregate;
  3846.     Field: TAggregateField;
  3847.   begin
  3848.     { Link persistent aggregate fields with TAggregate objects }
  3849.     MaxGrp := 0;
  3850.     FAggFieldsSize := 0;
  3851.     for I := 0 to AggFields.Count - 1 do
  3852.     begin
  3853.       Field := AggFields[I] as TAggregateField;
  3854.       if (Field.GroupingLevel = 0) or (Field.IndexName = FIndexName) then
  3855.       begin
  3856.         if Field.GroupingLevel > MaxGrp then
  3857.           MaxGrp := Field.GroupingLevel;
  3858.         if Field.Handle = nil then
  3859.         begin
  3860.           Agg := TAggregate.Create(nil, Self);
  3861.           Agg.Assign(Field);
  3862.           if not Agg.Active and (Agg.Expression <> '') then
  3863.           begin
  3864.             Agg.Active := True;
  3865.             Agg.Active := False;
  3866.           end;
  3867.           Field.Handle := Pointer(Agg);
  3868.           Field.ResultType := Agg.DataType;
  3869.         end else
  3870.         begin
  3871.           Agg := TAggregate(Field.Handle);
  3872.           Field.ResultType := Agg.DataType;
  3873.         end;
  3874.         Agg.RecBufOfs := FAggFieldsSize;
  3875.         Inc(FAggFieldsSize, Agg.DataSize + 1); { add one for null ind. }
  3876.       end;
  3877.     end;
  3878.     FAggGrpIndSize := MaxGrp * Sizeof(TGroupPosInds);
  3879.     FAggFieldsInit := True;
  3880.   end;
  3881. var
  3882.   I: Integer;
  3883.   Agg: TAggregate;
  3884.   Field: TAggregateField;
  3885. begin
  3886.   if (csLoading in ComponentState) then Exit;
  3887.   ClearActiveAggs;
  3888.   if FAggFieldsUpdated = nil then
  3889.     FAggFieldsUpdated := TBits.Create;
  3890.   if AggFields.Count + FAggregates.Count = 0 then Exit;
  3891.   FGroupingLevel := 0;
  3892.   FMaxAggGroupingLevel := 0;
  3893.   if not FAggFieldsInit then
  3894.     CreateAggsFromAggFields;
  3895.   if Assigned(DSCursor) and FAggregatesActive then
  3896.   begin
  3897.     for I := 0 to FAggregates.Count - 1 do
  3898.     begin
  3899.       Agg := FAggregates.GetItem(I);
  3900.       if Value then
  3901.         ResetAgg(Agg, False) else
  3902.         Agg.FInUse := False;
  3903.     end;
  3904.     for I := 0 to AggFields.Count - 1 do
  3905.     begin
  3906.       Field := AggFields[I] as TAggregateField;
  3907.       if (Field.Handle <> nil) then
  3908.       begin
  3909.         if (Field.GroupingLevel <> 0) and (Field.IndexName <> FIndexName) then
  3910.            TAggregate(Field.Handle).FInUse := False else
  3911.            TAggregate(Field.Handle).FInUse := True;
  3912.       end;
  3913.     end;
  3914.     ResetGrouping;
  3915.     DoAggUpdates(False);
  3916.   end;
  3917. end;
  3918.  
  3919. function TClientDataSet.InternalGetGroupState(Level: Integer): TGroupPosInds;
  3920. var
  3921.   Status: DBResult;
  3922.   DSGrpState: GROUPSTATE;
  3923. begin
  3924.   Status := FDSCursor.GetSubGroupState(Level, DSGrpState);
  3925.   if (Status = DBERR_NONE) or (Status = DBERR_BOF) or (Status = DBERR_EOF) then
  3926.     case DSGrpState of
  3927.       grSTATEMIDDLE: Result := [gbMiddle];
  3928.       grSTATEFIRST: Result := [gbFirst];
  3929.       grSTATELAST: Result := [gbLast];
  3930.       grSTATEFIRSTLAST: Result := [gbFirst, gbLast];
  3931.     end
  3932.   else
  3933.     Result := [];
  3934. end;
  3935.  
  3936. function TClientDataSet.GetGroupState(Level: Integer): TGroupPosInds;
  3937. begin
  3938.   if not Active or not AggregatesActive or (FIndexName = '') then
  3939.     Result := []
  3940.   else
  3941.   begin
  3942.     if Level > FGroupingLevel then
  3943.       DatabaseError(SAggsNoSuchLevel, Self);
  3944.     UpdateCursorPos;
  3945.     Result := InternalGetGroupState(Level);
  3946.   end;
  3947. end;
  3948.  
  3949. function TClientDataSet.GetActiveAggs(Index: Integer): TList;
  3950. begin
  3951.   if Index < FActiveAggLists.Count then
  3952.     Result := FActiveAggLists.Items[Index] else
  3953.     Result := nil;
  3954. end;
  3955.  
  3956. procedure TClientDataSet.DoAggUpdates(IsUpdate: Boolean);
  3957.  
  3958.   function Intersect(List1, List2: TBits): Boolean;
  3959.   var
  3960.     I: Integer;
  3961.   begin
  3962.     for I := 0 to List1.Size - 1 do
  3963.       if List1[I] and List2[I] then
  3964.       begin
  3965.         Result := True;
  3966.         Exit;
  3967.       end;
  3968.     Result := False;
  3969.   end;
  3970.  
  3971. var
  3972.   I: Integer;
  3973.   Agg: TAggregate;
  3974. begin
  3975.   for I := 0 to FAggregates.Count - 1 do
  3976.   begin
  3977.     Agg := FAggregates.Items[I];
  3978.     if Assigned(Agg.OnUpdate) and Agg.Active and Agg.InUse then
  3979.     begin
  3980.       if not IsUpdate or Intersect(FAggFieldsUpdated, Agg.DependentFields) then
  3981.         Agg.OnUpdate(Agg);
  3982.     end;
  3983.   end;
  3984.   for I := 0 to FAggFieldsUpdated.Size - 1 do
  3985.     FAggFieldsUpdated[I] := False;
  3986. end;
  3987.  
  3988. procedure TClientDataSet.GetAggFieldData(Buffer: PChar);
  3989. type
  3990.   PTGroupPosInds = ^TGroupPosInds;
  3991. var
  3992.   I: Integer;
  3993.   Agg: TAggregate;
  3994.   Blank: Bool;
  3995.   PAggData: PChar;
  3996. begin
  3997.   for I := 0 to AggFields.Count - 1 do
  3998.   begin
  3999.     Agg := TAggregate(TAggregateField(AggFields[I]).Handle);
  4000.     if (Agg <> nil) and Agg.InUse then
  4001.     begin
  4002.       PAggData := Buffer + FAggFieldsOfs + Agg.RecBufOfs;
  4003.       if Agg.InUse  and Agg.Active and (FDSCursor.GetAggregateValue(Agg.AggHandle,
  4004.          Pointer(PAggData+1), Blank) = DBERR_NONE) and not Blank then
  4005.         PAggData[0] := #0 else
  4006.         PAggData[0] := #1;
  4007.     end;
  4008.   end;
  4009. end;
  4010.  
  4011. function TClientDataSet.GetAggregateValue(Field: TField): Variant;
  4012. var
  4013.  Agg: TAggregate;
  4014.  RecBuf: PChar;
  4015. begin
  4016.  Result := NULL;
  4017.  if GetActiveRecBuf(RecBuf) then
  4018.  begin
  4019.    Agg := TAggregate(TAggregateField(Field).Handle);
  4020.    if Agg <> nil then
  4021.    begin
  4022.      if Agg.InUse then
  4023.      begin
  4024.        Inc(RecBuf, FAggFieldsOfs + Agg.RecBufOfs);
  4025.        if RecBuf[0] = #1 then
  4026.          Result := NULL else
  4027.          Result := AggValueAsVariant(Agg, RecBuf + 1)
  4028.      end else
  4029.        Result := NULL;
  4030.    end;
  4031.  end;
  4032. end;
  4033.  
  4034. procedure TClientDataSet.ResetAggField(Field: TField);
  4035. var
  4036.   I: Integer;
  4037.   Agg: TAggregate;
  4038.   AggF: TAggregateField;
  4039. begin
  4040.   for I := 0 to AggFields.Count - 1 do
  4041.     if AggFields[I] = Field then
  4042.     begin
  4043.       AggF := AggFields[I] as TAggregateField;
  4044.       Agg := TAggregate(AggF.Handle);
  4045.       if Agg <> nil then
  4046.       begin
  4047.         Agg.Active := False;
  4048.         Agg.Assign(AggF);
  4049.       end;
  4050.     end;
  4051. end;
  4052.  
  4053. function TClientDataSet.DoApplyUpdates(Delta: OleVariant; MaxErrors: Integer;
  4054.   out ErrorCount: Integer): OleVariant;
  4055. var
  4056.   OwnerData: OleVariant;
  4057. begin
  4058.   if Assigned(FBeforeApplyUpdates) then FBeforeApplyUpdates(Self, OwnerData);
  4059.   Result := AppServer.AS_ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
  4060.   if Assigned(FAfterApplyUpdates) then FAfterApplyUpdates(Self, OwnerData);
  4061. end;
  4062.  
  4063. function TClientDataSet.DoGetRecords(Count: Integer; out RecsOut: Integer;
  4064.   Options: Integer; const CommandText: WideString; Params: OleVariant): OleVariant;
  4065. var
  4066.   OwnerData: OleVariant;
  4067. begin
  4068.   if Assigned(FBeforeGetRecords) then FBeforeGetRecords(Self, OwnerData);
  4069.   Result := AppServer.AS_GetRecords(ProviderName, Count, RecsOut, Options,
  4070.     CommandText, Params, OwnerData);
  4071.   UnPackParams(Params, Self.Params);
  4072.   if Assigned(FAfterGetRecords) then FAfterGetRecords(Self, OwnerData);
  4073. end;
  4074.  
  4075. function TClientDataSet.DoRowRequest(Row: OleVariant; RequestType: Integer): OleVariant;
  4076. var
  4077.   OwnerData: OleVariant;
  4078. begin
  4079.   if Assigned(FBeforeRowRequest) then FBeforeRowRequest(Self, OwnerData);
  4080.   Result := AppServer.AS_RowRequest(ProviderName, Row, RequestType, OwnerData);
  4081.   if Assigned(FAfterRowRequest) then FAfterRowRequest(Self, OwnerData);
  4082. end;
  4083.  
  4084. procedure TClientDataSet.DoExecute(Params: OleVariant);
  4085. var
  4086.   OwnerData: OleVariant;
  4087. begin
  4088.   if Assigned(FBeforeExecute) then FBeforeExecute(Self, OwnerData);
  4089.   AppServer.AS_Execute(ProviderName, CommandText, Params, OwnerData);
  4090.   UnPackParams(Params, Self.Params);
  4091.   if Assigned(FAfterExecute) then FAfterExecute(Self, OwnerData);
  4092. end;
  4093.  
  4094. function TClientDataSet.ConstraintsStored: Boolean;
  4095. begin
  4096.   Result := Constraints.Count > 0;
  4097. end;
  4098.  
  4099. procedure TClientDataSet.SetupConstraints;
  4100. type
  4101.   TConstraintType = (ctField, ctRecord, ctDefault);
  4102.  
  4103.   procedure AddSQLExprAttr(ExprParser: TExprParser; const ExprText, ExprErrMsg,
  4104.     FieldName: string; FieldIndex: Integer; ConstraintType: TConstraintType;
  4105.     Required: Boolean);
  4106.   type
  4107.     PSQLExprInfo = ^TSQLExprInfo;
  4108.     TSQLExprInfo = packed record
  4109.       iErrStrLen: Integer;
  4110.       iFldNum: Integer;
  4111.       bReqExpr: BYTE;
  4112.     end;
  4113.   const
  4114.     TypeStr: array[TConstraintType] of PChar = (szBDEDOMCL, szBDERECCL, szBDEDEFCL);
  4115.     Attr: Integer = dsVaryingFldType or SizeOf(Integer) or (dsfldBYTES shl dsSizeBitsLen);
  4116.   var
  4117.     ErrorStr: string;
  4118.     AttrType: PChar;
  4119.     Len, AttrSize: Integer;
  4120.     SQLExprInfo: PSQLExprInfo;
  4121.     Options: TParserOptions;
  4122.     FBuffer: array of Byte;
  4123.   begin
  4124.     try
  4125.       SetLength(FBuffer, 4096);
  4126.       if ExprText = '' then Exit;
  4127.       if (ConstraintType <> ctDefault) and (ExprErrMsg = '') then
  4128.       begin
  4129.         if (ConstraintType = ctField) and (FieldName <> '') then
  4130.           ErrorStr := Format('%s %s: %s %s',[SConstraintFailed, SField, FieldName, ExprText]) else
  4131.           ErrorStr := Format('%s %s',[SConstraintFailed, ExprText]);
  4132.       end else
  4133.         ErrorStr := ExprErrMsg;
  4134.       Len := Length(ErrorStr);
  4135.       if (Len > 0) then Inc(Len);
  4136.       SQLExprInfo := @FBuffer[0];
  4137.       SQLExprInfo.iErrStrLen := Len;
  4138.       SQLExprInfo.iFldNum := FieldIndex;
  4139.       SQLExprInfo.bReqExpr := Ord(Required);
  4140.       Options := [poExtSyntax];
  4141.       if ConstraintType = ctDefault then Include(Options, poDefaultExpr);
  4142.       if ConstraintType = ctRecord then Include(Options, poUseOrigNames);
  4143.       if FieldName <> '' then Include(Options, poFieldNameGiven);
  4144.       with ExprParser do
  4145.       begin
  4146.         SetExprParams(ExprText, [], Options, FieldName);
  4147.         Move(FilterData[0], FBuffer[SizeOf(TSQLExprInfo) + Len ], DataSize);
  4148.         AttrSize := DataSize + SizeOf(TSQLExprInfo) + Len;
  4149.       end;
  4150.       if Len > 0 then
  4151.         StrCopy(@FBuffer[SizeOf(TSQLExprInfo)], PChar(ErrorStr));
  4152.       AttrType := TypeStr[ConstraintType];
  4153.       Check(FDSBase.AddOptParameter(0, AttrType, Attr, AttrSize + SizeOf(Integer), PByte(FBuffer)));
  4154.     finally
  4155.       FBuffer := nil;
  4156.     end;
  4157.   end;
  4158.  
  4159.  
  4160. var
  4161.   i: Integer;
  4162.   ExprParser: TExprParser;
  4163.   ErrMsg: string;
  4164. begin
  4165.   ExprParser := TExprParser.Create(Self, '', [], [], '', nil, FieldTypeMap);
  4166.   try
  4167.     if Constraints.Count > 0 then
  4168.     begin
  4169.       try
  4170.         for i := 0 to Constraints.Count - 1 do
  4171.           with Constraints[i] do
  4172.           begin
  4173.             AddSQLExprAttr(ExprParser, ImportedConstraint, ErrorMessage, '', 0,
  4174.               ctRecord, False);
  4175.             AddSQLExprAttr(ExprParser, CustomConstraint, ErrorMessage, '', 0,
  4176.               ctRecord, False);
  4177.           end;
  4178.       except
  4179.         on E: Exception do
  4180.         begin
  4181.           if Name <> '' then
  4182.             ErrMsg := Format('%s: %s',[Name, SRecConstFail]) else
  4183.             ErrMsg := SRecConstFail;
  4184.           raise EDSWriter.CreateFmt(ErrMsg, [E.Message]);
  4185.         end;
  4186.       end;
  4187.     end;
  4188.     for i := 0 to FieldList.Count - 1 do
  4189.       with FieldList[i] do
  4190.       begin
  4191.         try
  4192.           AddSQLExprAttr(ExprParser, DefaultExpression, '', FullName, i + 1,
  4193.             ctDefault, False);
  4194.         except
  4195.           on E: Exception do
  4196.           begin
  4197.             if Name <> '' then
  4198.               ErrMsg := Format('%s: %s',[Name, SDefExprFail]) else
  4199.             if DataSet.Name <> '' then
  4200.               ErrMsg := Format('%s.%s: %s',[Name, FullName, SDefExprFail]) else
  4201.               ErrMsg := Format('%s: %s',[FullName, SDefExprFail]);
  4202.             raise EDSWriter.CreateFmt(ErrMsg, [E.Message]);
  4203.           end;
  4204.         end;
  4205.         try
  4206.           AddSQLExprAttr(ExprParser, ImportedConstraint, ConstraintErrorMessage,
  4207.             FullName, i + 1, ctField, False);
  4208.           AddSQLExprAttr(ExprParser, CustomConstraint, ConstraintErrorMessage,
  4209.             FullName, i + 1, ctField, False);
  4210.         except
  4211.           on E: Exception do
  4212.           begin
  4213.             if Name <> '' then
  4214.               ErrMsg := Format('%s: %s',[Name, SFieldConstFail]) else
  4215. {
  4216.             if DataSet.Name <> '' then
  4217.               ErrMsg := Format('%s.%s: %s',[DataSet.Name, FullName, SFieldConstFail]) else
  4218.               ErrMsg := Format('%s: %s',[FullName, SFieldConstFail]); }
  4219.             raise EDSWriter.CreateFmt(ErrMsg, [E.Message]);
  4220.           end;
  4221.         end;
  4222.       end;
  4223.   finally
  4224.     ExprParser.Free;
  4225.   end;
  4226. end;
  4227.  
  4228. { TClientBlobStream }
  4229.  
  4230. constructor TClientBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
  4231. begin
  4232.   FField := Field;
  4233.   FFieldNo := FField.FieldNo;
  4234.   FDataSet := FField.DataSet as TClientDataSet;
  4235.   if not FDataSet.GetActiveRecBuf(FBuffer) then Exit;
  4236.   if Mode <> bmRead then
  4237.   begin
  4238.     if FField.ReadOnly then
  4239.       DatabaseErrorFmt(SFieldReadOnly, [FField.DisplayName], FDataSet);
  4240.     if not (FDataSet.State in [dsEdit, dsInsert, dsNewValue]) then
  4241.       DatabaseError(SNotEditing, FDataSet);
  4242.   end;
  4243.   if Mode = bmWrite then Truncate
  4244.   else ReadBlobData;
  4245. end;
  4246.  
  4247. destructor TClientBlobStream.Destroy;
  4248. begin
  4249.   if FModified then
  4250.   try
  4251.     FDataSet.Check(FDataSet.FDSCursor.PutBlob(FBuffer, FFieldNo, 0, Memory, Size));
  4252.     FField.Modified := True;
  4253.     FDataSet.DataEvent(deFieldChange, Longint(FField));
  4254.   except
  4255.     Application.HandleException(Self);
  4256.   end;
  4257.   inherited Destroy;
  4258. end;
  4259.  
  4260. procedure TClientBlobStream.ReadBlobData;
  4261. var
  4262.   BlobLen: DWord;
  4263. begin
  4264.   FDataSet.Check(FDataSet.FDSCursor.GetBlobLen(FBuffer, FFieldNo, BlobLen));
  4265.   if BlobLen > 0 then
  4266.   begin
  4267.     Position := 0;
  4268.     SetSize(BlobLen);
  4269.     FDataSet.Check(FDataSet.FDSCursor.GetBlob(FBuffer, FFieldNo, 0, Memory, BlobLen));
  4270.   end;
  4271. end;
  4272.  
  4273. function TClientBlobStream.Write(const Buffer; Count: Longint): Longint;
  4274. begin
  4275.   Result := inherited Write(Buffer, Count);
  4276.   FModified := True;
  4277. end;
  4278.  
  4279. procedure TClientBlobStream.Truncate;
  4280. begin
  4281.   Clear;
  4282.   FModified := True;
  4283. end;
  4284.  
  4285. { TAggregates }
  4286.  
  4287. constructor TAggregates.Create(Owner: TPersistent);
  4288. begin
  4289.   inherited Create(TAggregate);
  4290.   FOwner := Owner;
  4291. end;
  4292.  
  4293. function TAggregates.Add: TAggregate;
  4294. begin
  4295.   Result := TAggregate(inherited Add);
  4296.   Result.FDataSet := TClientDataSet(GetOwner);
  4297. end;
  4298.  
  4299. procedure TAggregates.Clear;
  4300. var
  4301.   DataSet: TClientDataSet;
  4302. begin
  4303.   inherited Clear;
  4304.   DataSet := TClientDataSet(GetOwner);
  4305.   if DataSet <> nil then
  4306.     DataSet.ResetAllAggs(DataSet.AggregatesActive);
  4307. end;
  4308.  
  4309. function TAggregates.GetOwner: TPersistent;
  4310. begin
  4311.   Result := FOwner;
  4312. end;
  4313.  
  4314. function TAggregates.GetItem(Index: Integer): TAggregate;
  4315. begin
  4316.   Result := TAggregate(inherited GetItem(Index));
  4317. end;
  4318.  
  4319. procedure TAggregates.SetItem(Index: Integer; Value: TAggregate);
  4320. begin
  4321.   inherited SetItem(Index, Value);
  4322. end;
  4323.  
  4324. function TAggregates.IndexOf(const DisplayName: string): Integer;
  4325. begin
  4326.   for Result := 0 to Count - 1 do
  4327.     if AnsiCompareText(TAggregate(Items[Result]).DisplayName, DisplayName) = 0 then Exit;
  4328.   Result := -1;
  4329. end;
  4330.  
  4331. function TAggregates.Find(const DisplayName: string): TAggregate;
  4332. var
  4333.   I: Integer;
  4334. begin
  4335.   I := IndexOf(DisplayName);
  4336.   if I < 0 then Result := nil else Result := TAggregate(Items[I]);
  4337. end;
  4338.  
  4339. { TAggregate }
  4340.  
  4341. constructor TAggregate.Create(Aggregates: TAggregates; ADataSet: TClientDataSet);
  4342. begin
  4343.   FDataSet := ADataSet;
  4344.   inherited Create(Aggregates);
  4345. end;
  4346.  
  4347. destructor TAggregate.Destroy;
  4348. var
  4349.   I: Integer;
  4350. begin
  4351.   if Assigned(FDataSet) and Assigned(FDataSet.AggFields) then
  4352.     for I := 0 to FDataSet.AggFields.Count - 1 do
  4353.       with TAggregateField(FDataSet.AggFields[I]) do
  4354.       begin
  4355.         if FHAggregate <> 0 then
  4356.         begin
  4357.           FDataset.FDSCursor.DropAggregate(FHAggregate);
  4358.           FHAggregate := 0;
  4359.         end;
  4360.         if Handle = Self then Handle := nil;
  4361.       end;
  4362.   if FDependentFields <> nil then
  4363.     FDependentFields.Free;
  4364.   inherited Destroy;
  4365. end;
  4366.  
  4367. procedure TAggregate.Activate;
  4368. var
  4369.   Parser: TExprParser;
  4370. begin
  4371.   if FOutOfDate and (FHAggregate <> 0) then
  4372.   begin
  4373.     FDataSet.Check(FDataSet.DSCursor.DropAggregate(FHAggregate));
  4374.     FHAggregate := 0;
  4375.   end;
  4376.   FOutOfDate := False;
  4377.   if FHAggregate = 0 then
  4378.   begin
  4379.     if FDependentFields = nil then
  4380.       FDependentFields := TBits.Create;
  4381.     if FExpression <> '' then
  4382.     begin
  4383.       Parser := TExprParser.Create(FDataSet, FExpression, [],
  4384.         [poExtSyntax, poAggregate, poFieldDepend], '', FDependentFields, FieldTypeMap);
  4385.       try
  4386.         FDataset.Check(FDataSet.DSCursor.AddAggregate(GroupingLevel,
  4387.           Parser.DataSize, Parser.FilterData, FHAggregate));
  4388.         FDataset.Check(FDataSet.DSCursor.GetAggregateDesc(FHAggregate, FFldDesc));
  4389.         SetLength(FDataBuffer, FFldDesc.iFldLen);
  4390.         if FFldDesc.iFldType < MAXLOGFLDTYPES then
  4391.           FDataType := DataTypeMap[FFldDesc.iFldType] 
  4392.         else if FFldDesc.iFldType = fldUNICODE then
  4393.           FDataType := ftWideString else
  4394.           FDataType := ftUnknown;
  4395.         FDataSize := FFldDesc.iFldLen;
  4396.       finally
  4397.         Parser.Free;
  4398.       end;
  4399.     end else
  4400.       FDataSet.Check(FDataSet.DSCursor.AddAggregate(GroupingLevel, 0, nil,
  4401.         FHAggregate));
  4402.   end;
  4403. end;
  4404.  
  4405. procedure TAggregate.Assign(Source: TPersistent);
  4406. begin
  4407.   if Source is TAggregate then
  4408.   begin
  4409.     DisplayName := TAggregate(Source).Displayname;
  4410.     Visible := TAggregate(Source).Visible;
  4411.     Expression := TAggregate(Source).Expression;
  4412.     IndexName := TAggregate(Source).IndexName;
  4413.     GroupingLevel := TAggregate(Source).GroupingLevel;
  4414.     Active := TAggregate(Source).Active;
  4415.   end
  4416.   else if Source is TAggregateField then
  4417.   begin
  4418.     DisplayName := TAggregateField(Source).DisplayName;
  4419.     Visible := TAggregateField(Source).Visible;
  4420.     Expression := TAggregateField(Source).Expression;
  4421.     IndexName := TAggregateField(Source).IndexName;
  4422.     GroupingLevel := TAggregateField(Source).GroupingLevel;
  4423.     Active := TAggregateField(Source).Active;
  4424.   end
  4425.   else
  4426.     inherited Assign(Source);
  4427. end;
  4428.  
  4429. function TAggregate.GetDisplayName: string;
  4430. begin
  4431.   Result := FAggregateName;
  4432.   if Result = '' then Result := Expression;
  4433.   if Result = '' then Result := inherited GetDisplayName;
  4434. end;
  4435.  
  4436. procedure TAggregate.SetActive(Value: Boolean);
  4437. begin
  4438.   if Value <> FActive then
  4439.   begin
  4440.     FActive := Value;
  4441.     if (FDataSet <> nil) and (FDataSet.FDSCursor <> nil) then
  4442.     try
  4443.       FDataSet.ResetAgg(Self, True);
  4444.     except
  4445.       FActive := False;
  4446.       raise;
  4447.     end;
  4448.   end;
  4449. end;
  4450.  
  4451. procedure TAggregate.SetExpression(const Text: string);
  4452. begin
  4453.   if ( FDataSet <> nil ) and (FExpression <> Text ) and Active
  4454.     and not (csLoading in FDataSet.ComponentState) then
  4455.     DatabaseError(SAggActive, FDataSet);
  4456.   if Text <> FExpression then
  4457.     FOutOfDate := True;
  4458.   FExpression := Text;
  4459. end;
  4460.  
  4461. procedure TAggregate.SetGroupingLevel(GroupingLevel: Integer);
  4462. begin
  4463.   if ( FDataSet <> nil ) and (GroupingLevel <> FGroupingLevel ) and Active
  4464.     and not (csLoading in FDataSet.ComponentState) then
  4465.     DatabaseError(SAggActive, FDataSet);
  4466.   if GroupingLevel <> FGroupingLevel then
  4467.     FOutOfDate := True;
  4468.   FGroupingLevel := GroupingLevel;
  4469. end;
  4470.  
  4471. procedure TAggregate.SetIndexName(Value: String);
  4472. begin
  4473.   if ( FDataSet <> nil ) and (FIndexName <> Value) and Active
  4474.     and not (csLoading in FDataSet.ComponentState) then
  4475.     DatabaseError(SAggActive, FDataSet);
  4476.   FIndexName := Value;
  4477. end;
  4478.  
  4479. function TAggregate.Value: Variant;
  4480. var
  4481.   Blank: Bool;
  4482. begin
  4483.   Result := Null;
  4484.   if InUse and Active and Assigned(FDataSet) then
  4485.   begin
  4486.     FDataSet.UpdateCursorPos;
  4487.     FDataSet.DSCursor.GetAggregateValue(FHAggregate, Pointer(FDataBuffer), Blank);
  4488.     if Blank then
  4489.       Result := NULL else
  4490.       Result := AggValueAsVariant(Self, FDataBuffer);
  4491.   end;
  4492. end;
  4493.  
  4494. end.
  4495.