ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBCustomDataSet.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 23 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
Revision 27 by tony, Tue Apr 14 13:10:23 2015 UTC

# Line 120 | Line 120 | type
120    { TIBStringField allows us to have strings longer than 8196 }
121  
122    TIBStringField = class(TStringField)
123 +  private
124 +    FInitialised: boolean;
125 +  protected
126 +    procedure SetSize(AValue: Integer); override;
127    public
128      constructor create(AOwner: TComponent); override;
129      class procedure CheckTypeSize(Value: Integer); override;
# Line 187 | Line 191 | type
191      property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
192    end;
193  
194 +  {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
195 +
196 +  TIBControlLink = class
197 +  private
198 +    FTIBDataSet: TIBCustomDataSet;
199 +    procedure SetIBDataSet(AValue: TIBCustomDataSet);
200 +  protected
201 +    procedure UpdateSQL(Sender: TObject); virtual;
202 +    procedure UpdateParams(Sender: TObject); virtual;
203 +  public
204 +    destructor Destroy; override;
205 +    property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
206 +  end;
207 +
208    TIBAutoCommit = (acDisabled, acCommitRetaining);
209  
210    { TIBCustomDataSet }
211    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
212  
213    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
214 <                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
214 >                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
215                                   of object;
216    TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
217                                     var UpdateAction: TIBUpdateAction) of object;
218  
219    TIBUpdateRecordTypes = set of TCachedUpdateStatus;
220  
221 +  TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
222 +
223 +  TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
224 +
225    TIBCustomDataSet = class(TDataset)
226    private
227      FAutoCommit: TIBAutoCommit;
# Line 229 | Line 251 | type
251      FDeletedRecords: Long;
252      FModelBuffer,
253      FOldBuffer: PChar;
254 +    FOnValidatePost: TOnValidatePost;
255      FOpen: Boolean;
256      FInternalPrepared: Boolean;
257      FQDelete,
# Line 239 | Line 262 | type
262      FRecordBufferSize: Integer;
263      FRecordCount: Integer;
264      FRecordSize: Integer;
265 +    FDataSetCloseAction: TDataSetCloseAction;
266      FUniDirectional: Boolean;
267      FUpdateMode: TUpdateMode;
268      FUpdateObject: TIBDataSetUpdateObject;
# Line 260 | Line 284 | type
284      FAliasNameList: array of string;
285      FBaseSQLSelect: TStrings;
286      FParser: TSelectSQLParser;
287 +    FCloseAction: TTransactionAction;
288 +    FInTransactionEnd: boolean;
289 +    FIBLinks: TList;
290      function GetSelectStmtHandle: TISC_STMT_HANDLE;
291      procedure SetUpdateMode(const Value: TUpdateMode);
292      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
# Line 272 | Line 299 | type
299      function CanRefresh: Boolean;
300      procedure CheckEditState;
301      procedure ClearBlobCache;
302 +    procedure ClearIBLinks;
303      procedure CopyRecordBuffer(Source, Dest: Pointer);
304      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
305      procedure DoAfterDatabaseDisconnect(Sender: TObject);
306      procedure DoDatabaseFree(Sender: TObject);
307 <    procedure DoBeforeTransactionEnd(Sender: TObject);
307 >    procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
308      procedure DoAfterTransactionEnd(Sender: TObject);
309      procedure DoTransactionFree(Sender: TObject);
310      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
# Line 299 | Line 327 | type
327      procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
328      procedure InternalRevertRecord(RecordNumber: Integer); virtual;
329      function IsVisible(Buffer: PChar): Boolean;
330 +    procedure RegisterIBLink(Sender: TIBControlLink);
331 +    procedure UnRegisterIBLink(Sender: TIBControlLink);
332      procedure SaveOldBuffer(Buffer: PChar);
333      procedure SetBufferChunks(Value: Integer);
334      procedure SetDatabase(Value: TIBDatabase);
# Line 367 | Line 397 | type
397      procedure DoBeforeDelete; override;
398      procedure DoAfterDelete; override;
399      procedure DoBeforeEdit; override;
400 +    procedure DoAfterEdit; override;
401      procedure DoBeforeInsert; override;
402      procedure DoAfterInsert; override;
403 +    procedure DoBeforeClose; override;
404      procedure DoBeforeOpen; override;
405      procedure DoBeforePost; override;
406      procedure DoAfterPost; override;
# Line 456 | Line 488 | type
488                                              write FAfterTransactionEnd;
489      property TransactionFree: TNotifyEvent read FTransactionFree
490                                             write FTransactionFree;
491 +    property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
492  
493    public
494      constructor Create(AOwner: TComponent); override;
# Line 489 | Line 522 | type
522                      const ResultFields: string): Variant; override;
523      function UpdateStatus: TUpdateStatus; override;
524      function IsSequenced: Boolean; override;
525 +    procedure Post; override;
526      function ParamByName(ParamName: String): TIBXSQLVAR;
527      property DBHandle: PISC_DB_HANDLE read GetDBHandle;
528      property TRHandle: PISC_TR_HANDLE read GetTRHandle;
# Line 496 | Line 530 | type
530      property UpdatesPending: Boolean read FUpdatesPending;
531      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
532                                                        write SetUpdateRecordTypes;
533 +    property DataSetCloseAction: TDataSetCloseAction
534 +               read FDataSetCloseAction write FDataSetCloseAction;
535  
536    published
537      property Database: TIBDatabase read GetDatabase write SetDatabase;
# Line 581 | Line 617 | type
617      property ParamCheck;
618      property UniDirectional;
619      property Filtered;
620 +    property DataSetCloseAction;
621  
622      property BeforeDatabaseDisconnect;
623      property AfterDatabaseDisconnect;
# Line 616 | Line 653 | type
653      property OnFilterRecord;
654      property OnNewRecord;
655      property OnPostError;
656 +    property OnValidatePost;
657    end;
658  
659    { TIBDSBlobStream }
# Line 713 | Line 751 | type
751      NextRelation : TRelationNode;
752    end;
753  
754 + { TIBControlLink }
755 +
756 + destructor TIBControlLink.Destroy;
757 + begin
758 +  IBDataSet := nil;
759 +  inherited Destroy;
760 + end;
761 +
762 + procedure TIBControlLink.UpdateParams(Sender: TObject);
763 + begin
764 +
765 + end;
766 +
767 + procedure TIBControlLink.UpdateSQL(Sender: TObject);
768 + begin
769 +
770 + end;
771 +
772 + procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
773 + begin
774 +  if FTIBDataSet = AValue then Exit;
775 +  if IBDataSet <> nil then
776 +    IBDataSet.UnRegisterIBLink(self);
777 +  FTIBDataSet := AValue;
778 +  if IBDataSet <> nil then
779 +    IBDataSet.RegisterIBLink(self);
780 + end;
781 +
782  
783   { TIBStringField}
784  
785 < constructor TIBStringField.Create(AOwner: TComponent);
785 > constructor TIBStringField.create(AOwner: TComponent);
786   begin
787    inherited Create(AOwner);
788   end;
# Line 773 | Line 839 | begin
839    end;
840   end;
841  
842 + procedure TIBStringField.SetSize(AValue: Integer);
843 + var FieldSize: integer;
844 + begin
845 +  if csLoading in ComponentState then
846 +    FInitialised := true;
847 +  if FInitialised then
848 +    inherited SetSize(AValue)
849 +  else
850 +  begin
851 +    {IBCustomDataSet encodes the CharWidth size in the size}
852 +    FieldSize := AValue div 4;
853 +    inherited SetSize(FieldSize);
854 +    DisplayWidth := FieldSize div ((AValue mod 4) + 1);
855 +    FInitialised := true;
856 +  end;
857 + end;
858 +
859   { TIBBCDField }
860  
861   constructor TIBBCDField.Create(AOwner: TComponent);
# Line 870 | Line 953 | begin
953    CheckIBLoaded;
954    FIBLoaded := True;
955    FBase := TIBBase.Create(Self);
956 +  FIBLinks := TList.Create;
957    FCurrentRecord := -1;
958    FDeletedRecords := 0;
959    FUniDirectional := False;
# Line 897 | Line 981 | begin
981    FGenerateParamNames := False;
982    FForcedRefresh := False;
983    FAutoCommit:= acDisabled;
984 +  FDataSetCloseAction := dcDiscardChanges;
985    {Bookmark Size is Integer for IBX}
986    BookmarkSize := SizeOf(Integer);
987    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
# Line 922 | Line 1007 | begin
1007      FDataLink.Free;
1008      FBase.Free;
1009      ClearBlobCache;
1010 +    ClearIBLinks;
1011 +    FIBLinks.Free;
1012      FBlobStreamList.Free;
1013      FreeMem(FBufferCache);
1014      FBufferCache := nil;
# Line 1366 | Line 1453 | begin
1453      FDatabaseFree(Sender);
1454   end;
1455  
1456 < procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1456 > procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1457 >  Action: TTransactionAction);
1458   begin
1459 <  if Active then
1460 <    Active := False;
1459 >  FCloseAction := Action;
1460 >  FInTransactionEnd := true;
1461 >  try
1462 >    if Active then
1463 >      Active := False;
1464 >  finally
1465 >    FInTransactionEnd := false;
1466 >  end;
1467    if FQSelect <> nil then
1468      FQSelect.FreeHandle;
1469    if FQDelete <> nil then
# Line 2283 | Line 2377 | begin
2377    end;
2378   end;
2379  
2380 + procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2381 + begin
2382 +  if FIBLinks.IndexOf(Sender) = -1 then
2383 +    FIBLinks.Add(Sender);
2384 + end;
2385 +
2386  
2387   procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2388   begin
# Line 2321 | Line 2421 | begin
2421    end;
2422   end;
2423  
2424 + procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2425 + begin
2426 +  FIBLinks.Remove(Sender);
2427 + end;
2428 +
2429   function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2430   begin
2431    if Active then
# Line 2553 | Line 2658 | end;
2658   procedure TIBCustomDataSet.DoAfterDelete;
2659   begin
2660    inherited DoAfterDelete;
2661 +  FBase.DoAfterDelete(self);
2662    InternalAutoCommit;
2663   end;
2664  
# Line 2570 | Line 2676 | begin
2676    inherited DoBeforeEdit;
2677   end;
2678  
2679 + procedure TIBCustomDataSet.DoAfterEdit;
2680 + begin
2681 +  inherited DoAfterEdit;
2682 +  FBase.DoAfterEdit(self);
2683 + end;
2684 +
2685   procedure TIBCustomDataSet.DoBeforeInsert;
2686   begin
2687    if not CanInsert then
# Line 2582 | Line 2694 | begin
2694    if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2695      GeneratorField.Apply;
2696    inherited DoAfterInsert;
2697 +  FBase.DoAfterInsert(self);
2698 + end;
2699 +
2700 + procedure TIBCustomDataSet.DoBeforeClose;
2701 + begin
2702 +  inherited DoBeforeClose;
2703 +  if State in [dsInsert,dsEdit] then
2704 +  begin
2705 +    if FInTransactionEnd and (FCloseAction = TARollback) then
2706 +       Exit;
2707 +
2708 +    if DataSetCloseAction = dcSaveChanges then
2709 +      Post;
2710 +      {Note this can fail with an exception e.g. due to
2711 +       database validation error. In which case the dataset remains open }
2712 +  end;
2713   end;
2714  
2715   procedure TIBCustomDataSet.DoBeforeOpen;
2716 + var i: integer;
2717   begin
2718    if assigned(FParser) then
2719       FParser.Reset;
2720 <  DataEvent(deCheckBrowseMode,1); {Conventional use to report getting ready to prepare}
2720 >  for i := 0 to FIBLinks.Count - 1 do
2721 >    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2722    inherited DoBeforeOpen;
2723 <  DataEvent(deCheckBrowseMode,2); {Conventional use to report the right time to set parameters}
2723 >  for i := 0 to FIBLinks.Count - 1 do
2724 >    TIBControlLink(FIBLinks[i]).UpdateParams(self);
2725   end;
2726  
2727   procedure TIBCustomDataSet.DoBeforePost;
# Line 2604 | Line 2735 | end;
2735   procedure TIBCustomDataSet.DoAfterPost;
2736   begin
2737    inherited DoAfterPost;
2738 +  FBase.DoAfterPost(self);
2739    InternalAutoCommit;
2740   end;
2741  
# Line 2741 | Line 2873 | begin
2873          Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2874          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2875          begin
2876 <          if fdDataLength <= Field.Size then
2876 >          if fdDataLength < Field.DataSize then
2877            begin
2878              Move(Data^, Buffer^, fdDataLength);
2879              PChar(Buffer)[fdDataLength] := #0;
# Line 3045 | Line 3177 | const
3177   var
3178    FieldType: TFieldType;
3179    FieldSize: Word;
3180 +  CharSetSize: integer;
3181    FieldNullable : Boolean;
3182    i, FieldPosition, FieldPrecision: Integer;
3183    FieldAliasName, DBAliasName: string;
# Line 3180 | Line 3313 | begin
3313             their values }
3314            SQL_VARYING, SQL_TEXT:
3315            begin
3316 <            FieldSize := sqllen;
3316 >            CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3317 >            {FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3318 >            FieldSize := sqllen * 4 + (CharSetSize - 1);
3319              FieldType := ftString;
3320            end;
3321            { All Doubles/Floats should be cast to doubles }
# Line 3560 | Line 3695 | begin
3695    inherited Loaded;
3696   end;
3697  
3698 + procedure TIBCustomDataSet.Post;
3699 + var CancelPost: boolean;
3700 + begin
3701 +  CancelPost := false;
3702 +  if assigned(FOnValidatePost) then
3703 +    OnValidatePost(self,CancelPost);
3704 +  if CancelPost then
3705 +    Cancel
3706 +  else
3707 +   inherited Post;
3708 + end;
3709 +
3710   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3711                                   Options: TLocateOptions): Boolean;
3712   var
# Line 3761 | Line 3908 | begin
3908   FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
3909   end;
3910  
3911 + procedure TIBCustomDataSet.ClearIBLinks;
3912 + var i: integer;
3913 + begin
3914 +  for i := FIBLinks.Count - 1 downto 0 do
3915 +    TIBControlLink(FIBLinks[i]).IBDataSet := nil;
3916 + end;
3917 +
3918  
3919   procedure TIBCustomDataSet.InternalUnPrepare;
3920   begin

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines