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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

# Line 27 | Line 27
27   {    IBX For Lazarus (Firebird Express)                                  }
28   {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29   {    Portions created by MWA Software are copyright McCallum Whyman      }
30 < {    Associates Ltd 2011                                                 }
30 > {    Associates Ltd 2011 - 2015                                                }
31   {                                                                        }
32   {************************************************************************}
33  
34   unit IBCustomDataSet;
35  
36 + {$R-}
37 +
38   {$Mode Delphi}
39  
40   {$IFDEF DELPHI}
# Line 47 | Line 49 | uses
49   {$ELSE}
50    unix,
51   {$ENDIF}
52 <  SysUtils, Classes, Forms, Controls, IBDatabase,
53 <  IBExternals, IB, IBHeader,  IBSQL, Db,
52 <  IBUtils, IBBlob;
52 >  SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
53 >  IBUtils, IBBlob, IBSQLParser;
54  
55   const
56    BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
# Line 118 | Line 119 | type
119    { TIBStringField allows us to have strings longer than 8196 }
120  
121    TIBStringField = class(TStringField)
122 +  private
123 +    FInitialised: boolean;
124 +  protected
125 +    procedure SetSize(AValue: Integer); override;
126    public
127      constructor create(AOwner: TComponent); override;
128      class procedure CheckTypeSize(Value: Integer); override;
# Line 185 | Line 190 | type
190      property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
191    end;
192  
193 +  {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
194 +
195 +  TIBControlLink = class
196 +  private
197 +    FTIBDataSet: TIBCustomDataSet;
198 +    procedure SetIBDataSet(AValue: TIBCustomDataSet);
199 +  protected
200 +    procedure UpdateSQL(Sender: TObject); virtual;
201 +    procedure UpdateParams(Sender: TObject); virtual;
202 +  public
203 +    destructor Destroy; override;
204 +    property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
205 +  end;
206 +
207 +  TIBAutoCommit = (acDisabled, acCommitRetaining);
208 +
209    { TIBCustomDataSet }
210    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
211  
212    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
213 <                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
213 >                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
214                                   of object;
215    TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
216                                     var UpdateAction: TIBUpdateAction) of object;
217  
218    TIBUpdateRecordTypes = set of TCachedUpdateStatus;
219  
220 +  TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
221 +
222 +  TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
223 +
224    TIBCustomDataSet = class(TDataset)
225    private
226 +    FAutoCommit: TIBAutoCommit;
227 +    FGenerateParamNames: Boolean;
228      FGeneratorField: TIBGenerator;
229      FNeedsRefresh: Boolean;
230      FForcedRefresh: Boolean;
# Line 223 | Line 250 | type
250      FDeletedRecords: Long;
251      FModelBuffer,
252      FOldBuffer: PChar;
253 +    FOnValidatePost: TOnValidatePost;
254      FOpen: Boolean;
255      FInternalPrepared: Boolean;
256      FQDelete,
# Line 233 | Line 261 | type
261      FRecordBufferSize: Integer;
262      FRecordCount: Integer;
263      FRecordSize: Integer;
264 +    FDataSetCloseAction: TDataSetCloseAction;
265      FUniDirectional: Boolean;
266      FUpdateMode: TUpdateMode;
267      FUpdateObject: TIBDataSetUpdateObject;
# Line 250 | Line 279 | type
279      FBeforeTransactionEnd,
280      FAfterTransactionEnd,
281      FTransactionFree: TNotifyEvent;
282 <
282 >    FAliasNameMap: array of string;
283 >    FAliasNameList: array of string;
284 >    FBaseSQLSelect: TStrings;
285 >    FParser: TSelectSQLParser;
286 >    FCloseAction: TTransactionAction;
287 >    FInTransactionEnd: boolean;
288 >    FIBLinks: TList;
289      function GetSelectStmtHandle: TISC_STMT_HANDLE;
290      procedure SetUpdateMode(const Value: TUpdateMode);
291      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
# Line 263 | Line 298 | type
298      function CanRefresh: Boolean;
299      procedure CheckEditState;
300      procedure ClearBlobCache;
301 +    procedure ClearIBLinks;
302      procedure CopyRecordBuffer(Source, Dest: Pointer);
303      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
304      procedure DoAfterDatabaseDisconnect(Sender: TObject);
305      procedure DoDatabaseFree(Sender: TObject);
306 <    procedure DoBeforeTransactionEnd(Sender: TObject);
306 >    procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
307      procedure DoAfterTransactionEnd(Sender: TObject);
308      procedure DoTransactionFree(Sender: TObject);
309      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
# Line 283 | Line 319 | type
319      function GetModifySQL: TStrings;
320      function GetTransaction: TIBTransaction;
321      function GetTRHandle: PISC_TR_HANDLE;
322 +    function GetParser: TSelectSQLParser;
323      procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
324      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
325                              Options: TLocateOptions): Boolean; virtual;
326      procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
327      procedure InternalRevertRecord(RecordNumber: Integer); virtual;
328      function IsVisible(Buffer: PChar): Boolean;
329 +    procedure RegisterIBLink(Sender: TIBControlLink);
330 +    procedure UnRegisterIBLink(Sender: TIBControlLink);
331      procedure SaveOldBuffer(Buffer: PChar);
332      procedure SetBufferChunks(Value: Integer);
333      procedure SetDatabase(Value: TIBDatabase);
# Line 321 | Line 360 | type
360      procedure DeactivateTransaction;
361      procedure CheckDatasetClosed;
362      procedure CheckDatasetOpen;
363 +    function CreateParser: TSelectSQLParser; virtual;
364 +    procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
365      function GetActiveBuf: PChar;
366      procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
367      procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
# Line 353 | Line 394 | type
394      procedure ClearCalcFields(Buffer: PChar); override;
395      function AllocRecordBuffer: PChar; override;
396      procedure DoBeforeDelete; override;
397 +    procedure DoAfterDelete; override;
398      procedure DoBeforeEdit; override;
399 +    procedure DoAfterEdit; override;
400      procedure DoBeforeInsert; override;
401      procedure DoAfterInsert; override;
402 +    procedure DoBeforeClose; override;
403 +    procedure DoBeforeOpen; override;
404      procedure DoBeforePost; override;
405 +    procedure DoAfterPost; override;
406      procedure FreeRecordBuffer(var Buffer: PChar); override;
407      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
408      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
409      function GetCanModify: Boolean; override;
410      function GetDataSource: TDataSource; override;
411 +    function GetDBAliasName(FieldNo: integer): string;
412 +    function GetFieldDefFromAlias(aliasName: string): TFieldDef;
413      function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
414      function GetRecNo: Integer; override;
415      function GetRecord(Buffer: PChar; GetMode: TGetMode;
416                         DoCheck: Boolean): TGetResult; override;
417      function GetRecordCount: Integer; override;
418      function GetRecordSize: Word; override;
419 +    procedure InternalAutoCommit;
420      procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
421      procedure InternalCancel; override;
422      procedure InternalClose; override;
# Line 385 | Line 434 | type
434      procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
435      procedure InternalSetToRecord(Buffer: PChar); override;
436      function IsCursorOpen: Boolean; override;
437 +    procedure Loaded; override;
438      procedure ReQuery;
439      procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
440      procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
441      procedure SetCachedUpdates(Value: Boolean);
442      procedure SetDataSource(Value: TDataSource);
443 +    procedure SetGenerateParamNames(AValue: Boolean); virtual;
444      procedure SetFieldData(Field : TField; Buffer : Pointer); override;
445      procedure SetFieldData(Field : TField; Buffer : Pointer;
446        NativeFormat : Boolean); overload; override;
# Line 397 | Line 448 | type
448  
449    protected
450      {Likely to be made public by descendant classes}
451 +    property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
452      property SQLParams: TIBXSQLDA read GetSQLParams;
453      property Params: TIBXSQLDA read GetSQLParams;
454      property InternalPrepared: Boolean read FInternalPrepared;
# Line 420 | Line 472 | type
472      property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
473      property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
474      property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
475 +    property Parser: TSelectSQLParser read GetParser;
476 +    property BaseSQLSelect: TStrings read FBaseSQLSelect;
477  
478      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
479                                                   write FBeforeDatabaseDisconnect;
# Line 433 | Line 487 | type
487                                              write FAfterTransactionEnd;
488      property TransactionFree: TNotifyEvent read FTransactionFree
489                                             write FTransactionFree;
490 +    property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
491  
492    public
493      constructor Create(AOwner: TComponent); override;
# Line 440 | Line 495 | type
495      procedure ApplyUpdates;
496      function CachedUpdateStatus: TCachedUpdateStatus;
497      procedure CancelUpdates;
498 +    function GetFieldPosition(AliasName: string): integer;
499      procedure FetchAll;
500      function LocateNext(const KeyFields: string; const KeyValues: Variant;
501                          Options: TLocateOptions): Boolean;
502      procedure RecordModified(Value: Boolean);
503      procedure RevertRecord;
504      procedure Undelete;
505 +    procedure ResetParser;
506 +    function HasParser: boolean;
507  
508      { TDataSet support methods }
509      function BookmarkValid(Bookmark: TBookmark): Boolean; override;
# Line 456 | Line 514 | type
514      function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
515      function GetFieldData(Field : TField; Buffer : Pointer;
516        NativeFormat : Boolean) : Boolean; overload; override;
517 +    property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
518      function Locate(const KeyFields: string; const KeyValues: Variant;
519                      Options: TLocateOptions): Boolean; override;
520      function Lookup(const KeyFields: string; const KeyValues: Variant;
521                      const ResultFields: string): Variant; override;
522      function UpdateStatus: TUpdateStatus; override;
523      function IsSequenced: Boolean; override;
524 +    procedure Post; override;
525      function ParamByName(ParamName: String): TIBXSQLVAR;
526      property DBHandle: PISC_DB_HANDLE read GetDBHandle;
527      property TRHandle: PISC_TR_HANDLE read GetTRHandle;
# Line 469 | Line 529 | type
529      property UpdatesPending: Boolean read FUpdatesPending;
530      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
531                                                        write SetUpdateRecordTypes;
532 +    property DataSetCloseAction: TDataSetCloseAction
533 +               read FDataSetCloseAction write FDataSetCloseAction;
534  
535    published
536      property Database: TIBDatabase read GetDatabase write SetDatabase;
# Line 507 | Line 569 | type
569                                                     write FOnUpdateRecord;
570    end;
571  
572 <  TIBDataSet = class(TIBCustomDataSet)
572 >  TIBParserDataSet = class(TIBCustomDataSet)
573 >  public
574 >    property Parser;
575 >  end;
576 >
577 >  TIBDataSet = class(TIBParserDataSet)
578    private
579      function GetPrepared: Boolean;
580  
# Line 532 | Line 599 | type
599      property QModify;
600      property StatementType;
601      property SelectStmtHandle;
602 +    property BaseSQLSelect;
603  
604    published
605      { TIBCustomDataSet }
606 +    property AutoCommit;
607      property BufferChunks;
608      property CachedUpdates;
609      property DeleteSQL;
# Line 543 | Line 612 | type
612      property SelectSQL;
613      property ModifySQL;
614      property GeneratorField;
615 +    property GenerateParamNames;
616      property ParamCheck;
617      property UniDirectional;
618      property Filtered;
619 +    property DataSetCloseAction;
620  
621      property BeforeDatabaseDisconnect;
622      property AfterDatabaseDisconnect;
# Line 581 | Line 652 | type
652      property OnFilterRecord;
653      property OnNewRecord;
654      property OnPostError;
655 +    property OnValidatePost;
656    end;
657  
658    { TIBDSBlobStream }
659    TIBDSBlobStream = class(TStream)
660 +  private
661 +    FHasWritten: boolean;
662    protected
663      FField: TField;
664      FBlobStream: TIBBlobStream;
665    public
666      constructor Create(AField: TField; ABlobStream: TIBBlobStream;
667                         Mode: TBlobStreamMode);
668 +    destructor Destroy; override;
669      function Read(var Buffer; Count: Longint): Longint; override;
670      function Seek(Offset: Longint; Origin: Word): Longint; override;
671      procedure SetSize(NewSize: Longint); override;
# Line 678 | Line 753 | type
753      NextRelation : TRelationNode;
754    end;
755  
756 + { TIBControlLink }
757 +
758 + destructor TIBControlLink.Destroy;
759 + begin
760 +  IBDataSet := nil;
761 +  inherited Destroy;
762 + end;
763 +
764 + procedure TIBControlLink.UpdateParams(Sender: TObject);
765 + begin
766 +
767 + end;
768 +
769 + procedure TIBControlLink.UpdateSQL(Sender: TObject);
770 + begin
771 +
772 + end;
773 +
774 + procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
775 + begin
776 +  if FTIBDataSet = AValue then Exit;
777 +  if IBDataSet <> nil then
778 +    IBDataSet.UnRegisterIBLink(self);
779 +  FTIBDataSet := AValue;
780 +  if IBDataSet <> nil then
781 +    IBDataSet.RegisterIBLink(self);
782 + end;
783 +
784  
785   { TIBStringField}
786  
787 < constructor TIBStringField.Create(AOwner: TComponent);
787 > constructor TIBStringField.create(AOwner: TComponent);
788   begin
789    inherited Create(AOwner);
790   end;
# Line 738 | Line 841 | begin
841    end;
842   end;
843  
844 + procedure TIBStringField.SetSize(AValue: Integer);
845 + var FieldSize: integer;
846 + begin
847 +  if csLoading in ComponentState then
848 +    FInitialised := true;
849 +  if FInitialised then
850 +    inherited SetSize(AValue)
851 +  else
852 +  begin
853 +    {IBCustomDataSet encodes the CharWidth size in the size}
854 +    FieldSize := AValue div 4;
855 +    inherited SetSize(FieldSize);
856 +    DisplayWidth := FieldSize div ((AValue mod 4) + 1);
857 +    FInitialised := true;
858 +  end;
859 + end;
860 +
861   { TIBBCDField }
862  
863   constructor TIBBCDField.Create(AOwner: TComponent);
# Line 835 | Line 955 | begin
955    CheckIBLoaded;
956    FIBLoaded := True;
957    FBase := TIBBase.Create(Self);
958 +  FIBLinks := TList.Create;
959    FCurrentRecord := -1;
960    FDeletedRecords := 0;
961    FUniDirectional := False;
# Line 859 | Line 980 | begin
980    FQModify.GoToFirstRecordOnExecute := False;
981    FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
982    FParamCheck := True;
983 +  FGenerateParamNames := False;
984    FForcedRefresh := False;
985 +  FAutoCommit:= acDisabled;
986 +  FDataSetCloseAction := dcDiscardChanges;
987    {Bookmark Size is Integer for IBX}
988    BookmarkSize := SizeOf(Integer);
989    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
# Line 873 | Line 997 | begin
997    else
998      if AOwner is TIBTransaction then
999        Transaction := TIBTransaction(AOwner);
1000 +  FBaseSQLSelect := TStringList.Create;
1001   end;
1002  
1003   destructor TIBCustomDataSet.Destroy;
# Line 884 | Line 1009 | begin
1009      FDataLink.Free;
1010      FBase.Free;
1011      ClearBlobCache;
1012 +    ClearIBLinks;
1013 +    FIBLinks.Free;
1014      FBlobStreamList.Free;
1015      FreeMem(FBufferCache);
1016      FBufferCache := nil;
# Line 893 | Line 1020 | begin
1020      FOldCacheSize := 0;
1021      FMappedFieldPosition := nil;
1022    end;
1023 +  if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1024 +  if assigned(FParser) then FParser.Free;
1025    inherited Destroy;
1026   end;
1027  
# Line 934 | Line 1063 | end;
1063  
1064   procedure TIBCustomDataSet.ApplyUpdates;
1065   var
1066 <  {$IF FPC_FULLVERSION > 20600 }
1066 >  {$IF FPC_FULLVERSION >= 20700 }
1067    CurBookmark: TBookmark;
1068    {$ELSE}
1069    CurBookmark: string;
# Line 1136 | Line 1265 | begin
1265    end;
1266   end;
1267  
1268 + function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1269 + var i: integer;
1270 +    Prepared: boolean;
1271 + begin
1272 +  Result := 0;
1273 +  Prepared := FInternalPrepared;
1274 +  if not Prepared then
1275 +    InternalPrepare;
1276 +  try
1277 +    for i := 0 to Length(FAliasNameList) - 1 do
1278 +      if FAliasNameList[i] = AliasName then
1279 +      begin
1280 +        Result := i + 1;
1281 +        Exit
1282 +      end;
1283 +  finally
1284 +    if not Prepared then
1285 +      InternalUnPrepare;
1286 +  end;
1287 + end;
1288 +
1289   procedure TIBCustomDataSet.ActivateConnection;
1290   begin
1291    if not Assigned(Database) then
# Line 1196 | Line 1346 | begin
1346      IBError(ibxeDatasetClosed, [nil]);
1347   end;
1348  
1349 + function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1350 + begin
1351 +  Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1352 +  Result.OnSQLChanging := SQLChanging
1353 + end;
1354 +
1355   procedure TIBCustomDataSet.CheckNotUniDirectional;
1356   begin
1357    if UniDirectional then
# Line 1299 | Line 1455 | begin
1455      FDatabaseFree(Sender);
1456   end;
1457  
1458 < procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1458 > procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1459 >  Action: TTransactionAction);
1460   begin
1461 <  if Active then
1462 <    Active := False;
1461 >  FCloseAction := Action;
1462 >  FInTransactionEnd := true;
1463 >  try
1464 >    if Active then
1465 >      Active := False;
1466 >  finally
1467 >    FInTransactionEnd := false;
1468 >  end;
1469    if FQSelect <> nil then
1470      FQSelect.FreeHandle;
1471    if FQDelete <> nil then
# Line 1340 | Line 1503 | var
1503    LocalData: Pointer;
1504    LocalDate, LocalDouble: Double;
1505    LocalInt: Integer;
1506 +  LocalBool: wordBool;
1507    LocalInt64: Int64;
1508    LocalCurrency: Currency;
1509    FieldsLoaded: Integer;
# Line 1484 | Line 1648 | begin
1648              end;
1649            end;
1650          end;
1651 +        SQL_BOOLEAN:
1652 +        begin
1653 +          LocalBool:= false;
1654 +          rdFields[j].fdDataSize := SizeOf(wordBool);
1655 +          if RecordNumber >= 0 then
1656 +            LocalBool := Qry.Current[i].AsBoolean;
1657 +          LocalData := PChar(@LocalBool);
1658 +        end;
1659          else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1660          begin
1661            rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
# Line 1626 | Line 1798 | function TIBCustomDataSet.InternalLocate
1798    const KeyValues: Variant; Options: TLocateOptions): Boolean;
1799   var
1800    keyFieldList: TList;
1801 <  {$IF FPC_FULLVERSION > 20600 }
1801 >  {$IF FPC_FULLVERSION >= 20700 }
1802    CurBookmark: TBookmark;
1803    {$ELSE}
1804    CurBookmark: string;
# Line 1755 | Line 1927 | end;
1927   procedure TIBCustomDataSet.InternalRefreshRow;
1928   var
1929    Buff: PChar;
1758  SetCursor: Boolean;
1930    ofs: DWORD;
1931    Qry: TIBSQL;
1932   begin
1933 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1763 <  if SetCursor then
1764 <    Screen.Cursor := crHourGlass;
1933 >  FBase.SetCursor;
1934    try
1935      Buff := GetActiveBuf;
1936      if CanRefresh then
# Line 1805 | Line 1974 | begin
1974      else
1975        IBError(ibxeCannotRefresh, [nil]);
1976    finally
1977 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1809 <      Screen.Cursor := crDefault;
1977 >    FBase.RestoreCursor;
1978    end;
1979   end;
1980  
# Line 1877 | Line 2045 | end;
2045  
2046   procedure TIBCustomDataSet.InternalPrepare;
2047   var
1880  SetCursor: Boolean;
2048    DidActivate: Boolean;
2049   begin
2050    if FInternalPrepared then
2051      Exit;
2052    DidActivate := False;
2053 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1887 <  if SetCursor then
1888 <    Screen.Cursor := crHourGlass;
2053 >  FBase.SetCursor;
2054    try
2055      ActivateConnection;
2056      DidActivate := ActivateTransaction;
2057      FBase.CheckDatabase;
2058      FBase.CheckTransaction;
2059 +    if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2060 +      FQSelect.SQL.Text := FParser.SQLText;
2061 + //   writeln( FQSelect.SQL.Text);
2062      if FQSelect.SQL.Text <> '' then
2063      begin
2064        if not FQSelect.Prepared then
2065        begin
2066 +        FQSelect.GenerateParamNames := FGenerateParamNames;
2067          FQSelect.ParamCheck := ParamCheck;
2068          FQSelect.Prepare;
2069        end;
2070 +      FQDelete.GenerateParamNames := FGenerateParamNames;
2071        if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2072          FQDelete.Prepare;
2073 +      FQInsert.GenerateParamNames := FGenerateParamNames;
2074        if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2075          FQInsert.Prepare;
2076 +      FQRefresh.GenerateParamNames := FGenerateParamNames;
2077        if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2078          FQRefresh.Prepare;
2079 +      FQModify.GenerateParamNames := FGenerateParamNames;
2080        if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2081          FQModify.Prepare;
2082        FInternalPrepared := True;
# Line 1913 | Line 2086 | begin
2086    finally
2087      if DidActivate then
2088        DeactivateTransaction;
2089 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1917 <      Screen.Cursor := crDefault;
2089 >    FBase.RestoreCursor;
2090    end;
2091   end;
2092  
# Line 2105 | Line 2277 | begin
2277              SQL_TIMESTAMP:
2278                Qry.Params[i].AsDateTime :=
2279                         TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2280 +            SQL_BOOLEAN:
2281 +              Qry.Params[i].AsBoolean := PWordBool(data)^;
2282            end;
2283          end;
2284        end;
# Line 2130 | Line 2304 | begin
2304    begin
2305      Disconnect;
2306      FQSelect.SQL.Assign(Value);
2307 +    FBaseSQLSelect.assign(Value);
2308    end;
2309   end;
2310  
# Line 2190 | Line 2365 | begin
2365    end;
2366   end;
2367  
2368 + procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2369 + begin
2370 +  if FIBLinks.IndexOf(Sender) = -1 then
2371 +    FIBLinks.Add(Sender);
2372 + end;
2373 +
2374  
2375   procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2376   begin
2377 <  if FOpen then
2378 <    InternalClose;
2377 >  Active := false;
2378 > {  if FOpen then
2379 >    InternalClose;}
2380    if FInternalPrepared then
2381      InternalUnPrepare;
2382 +  FieldDefs.Clear;
2383 +  FieldDefs.Updated := false;
2384   end;
2385  
2386   { I can "undelete" uninserted records (make them "inserted" again).
# Line 2225 | Line 2409 | begin
2409    end;
2410   end;
2411  
2412 + procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2413 + begin
2414 +  FIBLinks.Remove(Sender);
2415 + end;
2416 +
2417   function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2418   begin
2419    if Active then
# Line 2454 | Line 2643 | begin
2643    inherited DoBeforeDelete;
2644   end;
2645  
2646 + procedure TIBCustomDataSet.DoAfterDelete;
2647 + begin
2648 +  inherited DoAfterDelete;
2649 +  FBase.DoAfterDelete(self);
2650 +  InternalAutoCommit;
2651 + end;
2652 +
2653   procedure TIBCustomDataSet.DoBeforeEdit;
2654   var
2655    Buff: PRecordData;
# Line 2468 | Line 2664 | begin
2664    inherited DoBeforeEdit;
2665   end;
2666  
2667 + procedure TIBCustomDataSet.DoAfterEdit;
2668 + begin
2669 +  inherited DoAfterEdit;
2670 +  FBase.DoAfterEdit(self);
2671 + end;
2672 +
2673   procedure TIBCustomDataSet.DoBeforeInsert;
2674   begin
2675    if not CanInsert then
# Line 2480 | Line 2682 | begin
2682    if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2683      GeneratorField.Apply;
2684    inherited DoAfterInsert;
2685 +  FBase.DoAfterInsert(self);
2686 + end;
2687 +
2688 + procedure TIBCustomDataSet.DoBeforeClose;
2689 + begin
2690 +  inherited DoBeforeClose;
2691 +  if State in [dsInsert,dsEdit] then
2692 +  begin
2693 +    if FInTransactionEnd and (FCloseAction = TARollback) then
2694 +       Exit;
2695 +
2696 +    if DataSetCloseAction = dcSaveChanges then
2697 +      Post;
2698 +      {Note this can fail with an exception e.g. due to
2699 +       database validation error. In which case the dataset remains open }
2700 +  end;
2701 + end;
2702 +
2703 + procedure TIBCustomDataSet.DoBeforeOpen;
2704 + var i: integer;
2705 + begin
2706 +  if assigned(FParser) then
2707 +     FParser.Reset;
2708 +  for i := 0 to FIBLinks.Count - 1 do
2709 +    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2710 +  inherited DoBeforeOpen;
2711 +  for i := 0 to FIBLinks.Count - 1 do
2712 +    TIBControlLink(FIBLinks[i]).UpdateParams(self);
2713   end;
2714  
2715   procedure TIBCustomDataSet.DoBeforePost;
# Line 2490 | Line 2720 | begin
2720       GeneratorField.Apply
2721   end;
2722  
2723 + procedure TIBCustomDataSet.DoAfterPost;
2724 + begin
2725 +  inherited DoAfterPost;
2726 +  FBase.DoAfterPost(self);
2727 +  InternalAutoCommit;
2728 + end;
2729 +
2730   procedure TIBCustomDataSet.FetchAll;
2731   var
2732 <  SetCursor: Boolean;
2496 <  {$IF FPC_FULLVERSION > 20600 }
2732 >  {$IF FPC_FULLVERSION >= 20700 }
2733    CurBookmark: TBookmark;
2734    {$ELSE}
2735    CurBookmark: string;
2736    {$ENDIF}
2737   begin
2738 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2739 <  if SetCursor then
2504 <    Screen.Cursor := crHourGlass;
2505 <  try
2738 >  FBase.SetCursor;
2739 > try
2740      if FQSelect.EOF or not FQSelect.Open then
2741        exit;
2742      DisableControls;
# Line 2514 | Line 2748 | begin
2748        EnableControls;
2749      end;
2750    finally
2751 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2518 <      Screen.Cursor := crDefault;
2751 >    FBase.RestoreCursor;
2752    end;
2753   end;
2754  
# Line 2563 | Line 2796 | begin
2796      result := FDataLink.DataSource;
2797   end;
2798  
2799 + function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
2800 + begin
2801 +  Result := FAliasNameMap[FieldNo-1]
2802 + end;
2803 +
2804 + function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
2805 + var
2806 +   i: integer;
2807 + begin
2808 +   Result := nil;
2809 +   for i := 0 to Length(FAliasNameMap) - 1 do
2810 +       if FAliasNameMap[i] = aliasName then
2811 +       begin
2812 +         Result := FieldDefs[i];
2813 +         Exit
2814 +       end;
2815 + end;
2816 +
2817   function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
2818   begin
2819    Result := DefaultFieldClasses[FieldType];
# Line 2603 | Line 2854 | begin
2854          Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2855          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2856          begin
2857 <          if fdDataLength <= Field.Size then
2857 >          if fdDataLength < Field.DataSize then
2858            begin
2859              Move(Data^, Buffer^, fdDataLength);
2860              PChar(Buffer)[fdDataLength] := #0;
# Line 2652 | Line 2903 | begin
2903          if not Accept and (GetMode = gmCurrent) then
2904            GetMode := gmPrior;
2905        except
2906 < //        Application.HandleException(Self);
2906 > //        FBase.HandleException(Self);
2907        end;
2908      end;
2909      RestoreState(SaveState);
# Line 2746 | Line 2997 | begin
2997    result := FRecordBufferSize;
2998   end;
2999  
3000 + procedure TIBCustomDataSet.InternalAutoCommit;
3001 + begin
3002 +  with Transaction do
3003 +    if InTransaction and (FAutoCommit = acCommitRetaining) then
3004 +    begin
3005 +      if CachedUpdates then ApplyUpdates;
3006 +      CommitRetaining;
3007 +    end;
3008 + end;
3009 +
3010   procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3011   begin
3012    CheckEditState;
# Line 2823 | Line 3084 | end;
3084   procedure TIBCustomDataSet.InternalDelete;
3085   var
3086    Buff: PChar;
2826  SetCursor: Boolean;
3087   begin
3088 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2829 <  if SetCursor then
2830 <    Screen.Cursor := crHourGlass;
3088 >  FBase.SetCursor;
3089    try
3090      Buff := GetActiveBuf;
3091      if CanDelete then
# Line 2852 | Line 3110 | begin
3110      end else
3111        IBError(ibxeCannotDelete, [nil]);
3112    finally
3113 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2856 <      Screen.Cursor := crDefault;
3113 >    FBase.RestoreCursor;
3114    end;
3115   end;
3116  
# Line 2869 | Line 3126 | end;
3126  
3127   procedure TIBCustomDataSet.InternalHandleException;
3128   begin
3129 <  Application.HandleException(Self)
3129 >  FBase.HandleException(Self)
3130   end;
3131  
3132   procedure TIBCustomDataSet.InternalInitFieldDefs;
3133 + begin
3134 +  if not InternalPrepared then
3135 +  begin
3136 +    InternalPrepare;
3137 +    exit;
3138 +  end;
3139 +   FieldDefsFromQuery(FQSelect);
3140 + end;
3141 +
3142 + procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3143   const
3144    DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3145                 'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
# Line 2884 | Line 3151 | const
3151   var
3152    FieldType: TFieldType;
3153    FieldSize: Word;
3154 +  CharSetSize: integer;
3155    FieldNullable : Boolean;
3156    i, FieldPosition, FieldPrecision: Integer;
3157 <  FieldAliasName: string;
3157 >  FieldAliasName, DBAliasName: string;
3158    RelationName, FieldName: string;
3159    Query : TIBSQL;
3160    FieldIndex: Integer;
# Line 2986 | Line 3254 | var
3254    end;
3255  
3256   begin
2989  if not InternalPrepared then
2990  begin
2991    InternalPrepare;
2992    exit;
2993  end;
3257    FRelationNodes := TRelationNode.Create;
3258    FNeedsRefresh := False;
3259    Database.InternalTransaction.StartTransaction;
# Line 3001 | Line 3264 | begin
3264      FieldDefs.BeginUpdate;
3265      FieldDefs.Clear;
3266      FieldIndex := 0;
3267 <    if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3268 <      SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3267 >    if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3268 >      SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3269      Query.SQL.Text := DefaultSQL;
3270      Query.Prepare;
3271 <    for i := 0 to FQSelect.Current.Count - 1 do
3272 <      with FQSelect.Current[i].Data^ do
3271 >    SetLength(FAliasNameMap, SourceQuery.Current.Count);
3272 >    SetLength(FAliasNameList, SourceQuery.Current.Count);
3273 >    for i := 0 to SourceQuery.Current.Count - 1 do
3274 >      with SourceQuery.Current[i].Data^ do
3275        begin
3276          { Get the field name }
3277 <        SetString(FieldAliasName, aliasname, aliasname_length);
3277 >        FieldAliasName := SourceQuery.Current[i].Name;
3278 >        SetString(DBAliasName, aliasname, aliasname_length);
3279          SetString(RelationName, relname, relname_length);
3280          SetString(FieldName, sqlname, sqlname_length);
3281 +        FAliasNameList[i] := DBAliasName;
3282          FieldSize := 0;
3283          FieldPrecision := 0;
3284 <        FieldNullable := FQSelect.Current[i].IsNullable;
3284 >        FieldNullable := SourceQuery.Current[i].IsNullable;
3285          case sqltype and not 1 of
3286            { All VARCHAR's must be converted to strings before recording
3287             their values }
3288            SQL_VARYING, SQL_TEXT:
3289            begin
3290 <            FieldSize := sqllen;
3290 >            CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3291 >            {FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3292 >            FieldSize := sqllen * 4 + (CharSetSize - 1);
3293              FieldType := ftString;
3294            end;
3295            { All Doubles/Floats should be cast to doubles }
# Line 3089 | Line 3358 | begin
3358              FieldSize := sizeof (TISC_QUAD);
3359              FieldType := ftUnknown;
3360            end;
3361 +          SQL_BOOLEAN:
3362 +             FieldType:= ftBoolean;
3363            else
3364              FieldType := ftUnknown;
3365          end;
# Line 3100 | Line 3371 | begin
3371            with FieldDefs.AddFieldDef do
3372            begin
3373              Name := FieldAliasName;
3374 < (*           FieldNo := FieldPosition;*)
3374 >            FAliasNameMap[FieldNo-1] := DBAliasName;
3375              DataType := FieldType;
3376              Size := FieldSize;
3377              Precision := FieldPrecision;
# Line 3185 | Line 3456 | begin
3456          else case cur_field.DataType of
3457            ftString:
3458              cur_param.AsString := cur_field.AsString;
3459 <          ftBoolean, ftSmallint, ftWord:
3459 >          ftBoolean:
3460 >            cur_param.AsBoolean := cur_field.AsBoolean;
3461 >          ftSmallint, ftWord:
3462              cur_param.AsShort := cur_field.AsInteger;
3463            ftInteger:
3464              cur_param.AsLong := cur_field.AsInteger;
# Line 3238 | Line 3511 | begin
3511   end;
3512  
3513   procedure TIBCustomDataSet.InternalOpen;
3241 var
3242  SetCursor: Boolean;
3514  
3515    function RecordDataLength(n: Integer): Long;
3516    begin
# Line 3247 | Line 3518 | var
3518    end;
3519  
3520   begin
3521 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3251 <  if SetCursor then
3252 <    Screen.Cursor := crHourGlass;
3521 >  FBase.SetCursor;
3522    try
3523      ActivateConnection;
3524      ActivateTransaction;
# Line 3310 | Line 3579 | begin
3579      else
3580        FQSelect.ExecQuery;
3581    finally
3582 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3314 <      Screen.Cursor := crDefault;
3582 >    FBase.RestoreCursor;
3583    end;
3584   end;
3585  
# Line 3319 | Line 3587 | procedure TIBCustomDataSet.InternalPost;
3587   var
3588    Qry: TIBSQL;
3589    Buff: PChar;
3322  SetCursor: Boolean;
3590    bInserting: Boolean;
3591   begin
3592 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3326 <  if SetCursor then
3327 <    Screen.Cursor := crHourGlass;
3592 >  FBase.SetCursor;
3593    try
3594      Buff := GetActiveBuf;
3595      CheckEditState;
# Line 3362 | Line 3627 | begin
3627      if bInserting then
3628        Inc(FRecordCount);
3629    finally
3630 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3366 <      Screen.Cursor := crDefault;
3630 >    FBase.RestoreCursor;
3631    end;
3632   end;
3633  
# Line 3383 | Line 3647 | begin
3647    result := FOpen;
3648   end;
3649  
3650 + procedure TIBCustomDataSet.Loaded;
3651 + begin
3652 +  if assigned(FQSelect) then
3653 +    FBaseSQLSelect.assign(FQSelect.SQL);
3654 +  inherited Loaded;
3655 + end;
3656 +
3657 + procedure TIBCustomDataSet.Post;
3658 + var CancelPost: boolean;
3659 + begin
3660 +  CancelPost := false;
3661 +  if assigned(FOnValidatePost) then
3662 +    OnValidatePost(self,CancelPost);
3663 +  if CancelPost then
3664 +    Cancel
3665 +  else
3666 +   inherited Post;
3667 + end;
3668 +
3669   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3670                                   Options: TLocateOptions): Boolean;
3671   var
3672 <  {$IF FPC_FULLVERSION > 20600 }
3672 >  {$IF FPC_FULLVERSION >= 20700 }
3673    CurBookmark: TBookmark;
3674    {$ELSE}
3675    CurBookmark: string;
# Line 3408 | Line 3691 | function TIBCustomDataSet.Lookup(const K
3691                                   const ResultFields: string): Variant;
3692   var
3693    fl: TList;
3694 <  {$IF FPC_FULLVERSION > 20600 }
3694 >  {$IF FPC_FULLVERSION >= 20700 }
3695    CurBookmark: TBookmark;
3696    {$ELSE}
3697    CurBookmark: string;
# Line 3465 | Line 3748 | end;
3748   procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
3749   var
3750    Buff, TmpBuff: PChar;
3751 +  MappedFieldPos: integer;
3752   begin
3753    Buff := GetActiveBuf;
3754    if Field.FieldNo < 0 then
# Line 3481 | Line 3765 | begin
3765      begin
3766        { If inserting, Adjust record position }
3767        AdjustRecordOnInsert(Buff);
3768 <      if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3769 <         (FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
3768 >      MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
3769 >      if (MappedFieldPos > 0) and
3770 >         (MappedFieldPos <= rdFieldCount) then
3771        begin
3772          Field.Validate(Buffer);
3773          if (Buffer = nil) or
3774             (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
3775 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
3775 >          rdFields[MappedFieldPos].fdIsNull := True
3776          else begin
3777 <          Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
3778 <                 rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
3779 <          if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
3780 <             (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
3781 <            rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3782 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
3777 >          Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
3778 >                 rdFields[MappedFieldPos].fdDataSize);
3779 >          if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
3780 >             (rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
3781 >            rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
3782 >          rdFields[MappedFieldPos].fdIsNull := False;
3783            if rdUpdateStatus = usUnmodified then
3784            begin
3785              if CachedUpdates then
# Line 3582 | Line 3867 | begin
3867   FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
3868   end;
3869  
3870 + procedure TIBCustomDataSet.ClearIBLinks;
3871 + var i: integer;
3872 + begin
3873 +  for i := FIBLinks.Count - 1 downto 0 do
3874 +    TIBControlLink(FIBLinks[i]).IBDataSet := nil;
3875 + end;
3876 +
3877  
3878   procedure TIBCustomDataSet.InternalUnPrepare;
3879   begin
# Line 3589 | Line 3881 | begin
3881    begin
3882      CheckDatasetClosed;
3883      FieldDefs.Clear;
3884 +    FieldDefs.Updated := false;
3885      FInternalPrepared := False;
3886 +    Setlength(FAliasNameList,0);
3887    end;
3888   end;
3889  
3890   procedure TIBCustomDataSet.InternalExecQuery;
3891   var
3892    DidActivate: Boolean;
3599  SetCursor: Boolean;
3893   begin
3894    DidActivate := False;
3895 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3603 <  if SetCursor then
3604 <    Screen.Cursor := crHourGlass;
3895 >  FBase.SetCursor;
3896    try
3897      ActivateConnection;
3898      DidActivate := ActivateTransaction;
# Line 3618 | Line 3909 | begin
3909    finally
3910      if DidActivate then
3911        DeactivateTransaction;
3912 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3622 <      Screen.Cursor := crDefault;
3912 >    FBase.RestoreCursor;
3913    end;
3914   end;
3915  
# Line 3628 | Line 3918 | begin
3918    Result := FQSelect.Handle;
3919   end;
3920  
3921 + function TIBCustomDataSet.GetParser: TSelectSQLParser;
3922 + begin
3923 +  if not assigned(FParser) then
3924 +    FParser := CreateParser;
3925 +  Result := FParser
3926 + end;
3927 +
3928 + procedure TIBCustomDataSet.ResetParser;
3929 + begin
3930 +  if assigned(FParser) then
3931 +  begin
3932 +    FParser.Free;
3933 +    FParser := nil;
3934 +    SQLChanging(nil)
3935 +  end;
3936 + end;
3937 +
3938 + function TIBCustomDataSet.HasParser: boolean;
3939 + begin
3940 +  Result := not (csDesigning in ComponentState) and (FParser <> nil)
3941 + end;
3942 +
3943 + procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
3944 + begin
3945 +  if FGenerateParamNames = AValue then Exit;
3946 +  FGenerateParamNames := AValue;
3947 +  Disconnect
3948 + end;
3949 +
3950   procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
3951   begin
3952    inherited InitRecord(Buffer);
# Line 3962 | Line 4281 | begin
4281      FBlobStream.Truncate;
4282   end;
4283  
4284 + destructor TIBDSBlobStream.Destroy;
4285 + begin
4286 +  if FHasWritten then
4287 +     TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4288 +  inherited Destroy;
4289 + end;
4290 +
4291   function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4292   begin
4293    result := FBlobStream.Read(Buffer, Count);
# Line 3984 | Line 4310 | begin
4310    TIBCustomDataSet(FField.DataSet).RecordModified(True);
4311    TBlobField(FField).Modified := true;
4312    result := FBlobStream.Write(Buffer, Count);
4313 <  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4313 >  FHasWritten := true;
4314 > {  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4315 >  Removed as this caused a seek to beginning of the blob stream thus corrupting
4316 >  the blob stream. Moved to the destructor i.e. called after blob written}
4317   end;
4318  
4319   { TIBGenerator }
# Line 4031 | Line 4360 | end;
4360  
4361   procedure TIBGenerator.Apply;
4362   begin
4363 <  if (FGeneratorName <> '') and (FFieldName <> '')  then
4363 >  if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4364      Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4365   end;
4366  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines