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 41 by tony, Sat Jul 16 12:25:48 2016 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 + {$IF FPC_FULLVERSION >= 20700 }
37 + {$codepage UTF8}
38 + {$DEFINE HAS_ANSISTRING_CODEPAGE}
39 + {$DEFINE NEW_TBOOKMARK}
40 + {$ENDIF}
41 +
42 + {$R-}
43 +
44   {$Mode Delphi}
45  
46   {$IFDEF DELPHI}
# Line 47 | Line 55 | uses
55   {$ELSE}
56    unix,
57   {$ENDIF}
58 <  SysUtils, Classes, Forms, Controls, IBDatabase,
59 <  IBExternals, IB, IBHeader,  IBSQL, Db,
52 <  IBUtils, IBBlob;
58 >  SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
59 >  IBUtils, IBBlob, IBSQLParser;
60  
61   const
62    BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
# Line 118 | Line 125 | type
125    { TIBStringField allows us to have strings longer than 8196 }
126  
127    TIBStringField = class(TStringField)
128 +  private
129 +    FCharacterSetName: RawByteString;
130 +    FCharacterSetSize: integer;
131 +  protected
132 +    function GetDefaultWidth: Longint; override;
133    public
134 <    constructor create(AOwner: TComponent); override;
134 >    constructor Create(aOwner: TComponent); override;
135      class procedure CheckTypeSize(Value: Integer); override;
136      function GetAsString: string; override;
137      function GetAsVariant: Variant; override;
138      function GetValue(var Value: string): Boolean;
139      procedure SetAsString(const Value: string); override;
140 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
141 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
142 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
143 +    private
144 +      FCodePage: TSystemCodePage;
145 +    public
146 +      property CodePage: TSystemCodePage read FCodePage write FCodePage;
147 +    {$ENDIF}
148 +  end;
149 +
150 +  { TIBWideStringField }
151 +
152 +  TIBWideStringField = class(TWideStringField)
153 +  private
154 +    FCharacterSetName: RawByteString;
155 +    FCharacterSetSize: integer;
156 +  public
157 +    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
158 +    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
159    end;
160  
161    { TIBBCDField }
# Line 147 | Line 178 | type
178      property Size default 8;
179    end;
180  
181 +  {TIBMemoField}
182 +  {Allows us to show truncated text in DBGrids and anything else that uses
183 +   DisplayText}
184 +
185 +   TIBMemoField = class(TMemoField)
186 +   private
187 +     FCharacterSetName: RawByteString;
188 +     FCharacterSetSize: integer;
189 +     FDisplayTextAsClassName: boolean;
190 +     function GetTruncatedText: string;
191 +   protected
192 +     function GetAsString: string; override;
193 +     function GetDefaultWidth: Longint; override;
194 +     procedure GetText(var AText: string; ADisplayText: Boolean); override;
195 +     procedure SetAsString(const AValue: string); override;
196 +   public
197 +     constructor Create(AOwner: TComponent); override;
198 +     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
199 +     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
200 +   published
201 +     property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
202 +                                            write FDisplayTextAsClassName;
203 +   {$IFDEF HAS_ANSISTRING_CODEPAGE}
204 +   private
205 +     FCodePage: TSystemCodePage;
206 +     FFCodePage: TSystemCodePage;
207 +   public
208 +     property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
209 +   {$ENDIF}
210 +   end;
211 +
212 +   { TIBWideMemoField }
213 +
214 +   TIBWideMemoField = class(TWideMemoField)
215 +   private
216 +     FCharacterSetName: RawByteString;
217 +     FCharacterSetSize: integer;
218 +     FDisplayTextAsClassName: boolean;
219 +     function GetTruncatedText: string;
220 +   protected
221 +     function GetDefaultWidth: Longint; override;
222 +     procedure GetText(var AText: string; ADisplayText: Boolean); override;
223 +   public
224 +     constructor Create(AOwner: TComponent); override;
225 +     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
226 +     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
227 +   published
228 +      property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
229 +                                             write FDisplayTextAsClassName;
230 +   end;
231 +
232    TIBDataLink = class(TDetailDataLink)
233    private
234      FDataSet: TIBCustomDataSet;
# Line 185 | Line 267 | type
267      property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
268    end;
269  
270 +  {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
271 +
272 +  TIBControlLink = class
273 +  private
274 +    FTIBDataSet: TIBCustomDataSet;
275 +    procedure SetIBDataSet(AValue: TIBCustomDataSet);
276 +  protected
277 +    procedure UpdateSQL(Sender: TObject); virtual;
278 +    procedure UpdateParams(Sender: TObject); virtual;
279 +  public
280 +    destructor Destroy; override;
281 +    property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
282 +  end;
283 +
284 +  TIBAutoCommit = (acDisabled, acCommitRetaining);
285 +
286    { TIBCustomDataSet }
287    TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
288  
289    TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
290 <                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
290 >                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
291                                   of object;
292    TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
293                                     var UpdateAction: TIBUpdateAction) of object;
294  
295    TIBUpdateRecordTypes = set of TCachedUpdateStatus;
296  
297 +  TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
298 +
299 +  TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
300 +
301    TIBCustomDataSet = class(TDataset)
302    private
303 +    FAutoCommit: TIBAutoCommit;
304 +    FGenerateParamNames: Boolean;
305      FGeneratorField: TIBGenerator;
306      FNeedsRefresh: Boolean;
307      FForcedRefresh: Boolean;
# Line 223 | Line 327 | type
327      FDeletedRecords: Long;
328      FModelBuffer,
329      FOldBuffer: PChar;
330 +    FOnValidatePost: TOnValidatePost;
331      FOpen: Boolean;
332      FInternalPrepared: Boolean;
333      FQDelete,
# Line 233 | Line 338 | type
338      FRecordBufferSize: Integer;
339      FRecordCount: Integer;
340      FRecordSize: Integer;
341 +    FDataSetCloseAction: TDataSetCloseAction;
342      FUniDirectional: Boolean;
343      FUpdateMode: TUpdateMode;
344      FUpdateObject: TIBDataSetUpdateObject;
# Line 250 | Line 356 | type
356      FBeforeTransactionEnd,
357      FAfterTransactionEnd,
358      FTransactionFree: TNotifyEvent;
359 <
359 >    FAliasNameMap: array of string;
360 >    FAliasNameList: array of string;
361 >    FBaseSQLSelect: TStrings;
362 >    FParser: TSelectSQLParser;
363 >    FCloseAction: TTransactionAction;
364 >    FInTransactionEnd: boolean;
365 >    FIBLinks: TList;
366      function GetSelectStmtHandle: TISC_STMT_HANDLE;
367      procedure SetUpdateMode(const Value: TUpdateMode);
368      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
# Line 263 | Line 375 | type
375      function CanRefresh: Boolean;
376      procedure CheckEditState;
377      procedure ClearBlobCache;
378 +    procedure ClearIBLinks;
379      procedure CopyRecordBuffer(Source, Dest: Pointer);
380      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
381      procedure DoAfterDatabaseDisconnect(Sender: TObject);
382      procedure DoDatabaseFree(Sender: TObject);
383 <    procedure DoBeforeTransactionEnd(Sender: TObject);
383 >    procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
384      procedure DoAfterTransactionEnd(Sender: TObject);
385      procedure DoTransactionFree(Sender: TObject);
386      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
# Line 283 | Line 396 | type
396      function GetModifySQL: TStrings;
397      function GetTransaction: TIBTransaction;
398      function GetTRHandle: PISC_TR_HANDLE;
399 +    function GetParser: TSelectSQLParser;
400      procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
401      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
402                              Options: TLocateOptions): Boolean; virtual;
403      procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
404      procedure InternalRevertRecord(RecordNumber: Integer); virtual;
405      function IsVisible(Buffer: PChar): Boolean;
406 +    procedure RegisterIBLink(Sender: TIBControlLink);
407 +    procedure UnRegisterIBLink(Sender: TIBControlLink);
408      procedure SaveOldBuffer(Buffer: PChar);
409      procedure SetBufferChunks(Value: Integer);
410      procedure SetDatabase(Value: TIBDatabase);
# Line 302 | Line 418 | type
418      procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
419      procedure SetUniDirectional(Value: Boolean);
420      procedure RefreshParams;
305    procedure SQLChanging(Sender: TObject); virtual;
421      function AdjustPosition(FCache: PChar; Offset: DWORD;
422                              Origin: Integer): DWORD;
423      procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
# Line 321 | Line 436 | type
436      procedure DeactivateTransaction;
437      procedure CheckDatasetClosed;
438      procedure CheckDatasetOpen;
439 +    function CreateParser: TSelectSQLParser; virtual;
440 +    procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
441      function GetActiveBuf: PChar;
442      procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
443      procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
# Line 330 | Line 447 | type
447      procedure InternalRefreshRow; virtual;
448      procedure InternalSetParamsFromCursor; virtual;
449      procedure CheckNotUniDirectional;
450 +    procedure SQLChanging(Sender: TObject); virtual;
451 +    procedure SQLChanged(Sender: TObject); virtual;
452  
453   (*    { IProviderSupport }
454      procedure PSEndTransaction(Commit: Boolean); override;
# Line 353 | Line 472 | type
472      procedure ClearCalcFields(Buffer: PChar); override;
473      function AllocRecordBuffer: PChar; override;
474      procedure DoBeforeDelete; override;
475 +    procedure DoAfterDelete; override;
476      procedure DoBeforeEdit; override;
477 +    procedure DoAfterEdit; override;
478      procedure DoBeforeInsert; override;
479      procedure DoAfterInsert; override;
480 +    procedure DoBeforeClose; override;
481 +    procedure DoBeforeOpen; override;
482      procedure DoBeforePost; override;
483 +    procedure DoAfterPost; override;
484      procedure FreeRecordBuffer(var Buffer: PChar); override;
485      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
486      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
487      function GetCanModify: Boolean; override;
488      function GetDataSource: TDataSource; override;
489 +    function GetDBAliasName(FieldNo: integer): string;
490 +    function GetFieldDefFromAlias(aliasName: string): TFieldDef;
491      function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
492      function GetRecNo: Integer; override;
493      function GetRecord(Buffer: PChar; GetMode: TGetMode;
494                         DoCheck: Boolean): TGetResult; override;
495      function GetRecordCount: Integer; override;
496      function GetRecordSize: Word; override;
497 +    procedure InternalAutoCommit;
498      procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
499      procedure InternalCancel; override;
500      procedure InternalClose; override;
# Line 385 | Line 512 | type
512      procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
513      procedure InternalSetToRecord(Buffer: PChar); override;
514      function IsCursorOpen: Boolean; override;
515 +    procedure Loaded; override;
516      procedure ReQuery;
517      procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
518      procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
519      procedure SetCachedUpdates(Value: Boolean);
520      procedure SetDataSource(Value: TDataSource);
521 +    procedure SetGenerateParamNames(AValue: Boolean); virtual;
522      procedure SetFieldData(Field : TField; Buffer : Pointer); override;
523      procedure SetFieldData(Field : TField; Buffer : Pointer;
524        NativeFormat : Boolean); overload; override;
# Line 397 | Line 526 | type
526  
527    protected
528      {Likely to be made public by descendant classes}
529 +    property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
530      property SQLParams: TIBXSQLDA read GetSQLParams;
531      property Params: TIBXSQLDA read GetSQLParams;
532      property InternalPrepared: Boolean read FInternalPrepared;
# Line 420 | Line 550 | type
550      property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
551      property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
552      property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
553 +    property Parser: TSelectSQLParser read GetParser;
554 +    property BaseSQLSelect: TStrings read FBaseSQLSelect;
555  
556      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
557                                                   write FBeforeDatabaseDisconnect;
# Line 433 | Line 565 | type
565                                              write FAfterTransactionEnd;
566      property TransactionFree: TNotifyEvent read FTransactionFree
567                                             write FTransactionFree;
568 +    property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
569  
570    public
571      constructor Create(AOwner: TComponent); override;
# Line 440 | Line 573 | type
573      procedure ApplyUpdates;
574      function CachedUpdateStatus: TCachedUpdateStatus;
575      procedure CancelUpdates;
576 +    function GetFieldPosition(AliasName: string): integer;
577      procedure FetchAll;
578      function LocateNext(const KeyFields: string; const KeyValues: Variant;
579                          Options: TLocateOptions): Boolean;
580      procedure RecordModified(Value: Boolean);
581      procedure RevertRecord;
582      procedure Undelete;
583 +    procedure ResetParser; virtual;
584 +    function HasParser: boolean;
585  
586      { TDataSet support methods }
587      function BookmarkValid(Bookmark: TBookmark): Boolean; override;
# Line 456 | Line 592 | type
592      function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
593      function GetFieldData(Field : TField; Buffer : Pointer;
594        NativeFormat : Boolean) : Boolean; overload; override;
595 +    property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
596      function Locate(const KeyFields: string; const KeyValues: Variant;
597                      Options: TLocateOptions): Boolean; override;
598      function Lookup(const KeyFields: string; const KeyValues: Variant;
599                      const ResultFields: string): Variant; override;
600      function UpdateStatus: TUpdateStatus; override;
601      function IsSequenced: Boolean; override;
602 +    procedure Post; override;
603      function ParamByName(ParamName: String): TIBXSQLVAR;
604      property DBHandle: PISC_DB_HANDLE read GetDBHandle;
605      property TRHandle: PISC_TR_HANDLE read GetTRHandle;
# Line 469 | Line 607 | type
607      property UpdatesPending: Boolean read FUpdatesPending;
608      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
609                                                        write SetUpdateRecordTypes;
610 +    property DataSetCloseAction: TDataSetCloseAction
611 +               read FDataSetCloseAction write FDataSetCloseAction;
612  
613    published
614      property Database: TIBDatabase read GetDatabase write SetDatabase;
# Line 507 | Line 647 | type
647                                                     write FOnUpdateRecord;
648    end;
649  
650 <  TIBDataSet = class(TIBCustomDataSet)
650 >  TIBParserDataSet = class(TIBCustomDataSet)
651 >  public
652 >    property Parser;
653 >  end;
654 >
655 >  TIBDataSet = class(TIBParserDataSet)
656    private
657      function GetPrepared: Boolean;
658  
# Line 532 | Line 677 | type
677      property QModify;
678      property StatementType;
679      property SelectStmtHandle;
680 +    property BaseSQLSelect;
681  
682    published
683      { TIBCustomDataSet }
684 +    property AutoCommit;
685      property BufferChunks;
686      property CachedUpdates;
687      property DeleteSQL;
# Line 543 | Line 690 | type
690      property SelectSQL;
691      property ModifySQL;
692      property GeneratorField;
693 +    property GenerateParamNames;
694      property ParamCheck;
695      property UniDirectional;
696      property Filtered;
697 +    property DataSetCloseAction;
698  
699      property BeforeDatabaseDisconnect;
700      property AfterDatabaseDisconnect;
# Line 581 | Line 730 | type
730      property OnFilterRecord;
731      property OnNewRecord;
732      property OnPostError;
733 +    property OnValidatePost;
734    end;
735  
736    { TIBDSBlobStream }
737    TIBDSBlobStream = class(TStream)
738 +  private
739 +    FHasWritten: boolean;
740    protected
741      FField: TField;
742      FBlobStream: TIBBlobStream;
743 +    function  GetSize: Int64; override;
744    public
745      constructor Create(AField: TField; ABlobStream: TIBBlobStream;
746                         Mode: TBlobStreamMode);
747 +    destructor Destroy; override;
748      function Read(var Buffer; Count: Longint): Longint; override;
749      function Seek(Offset: Longint; Origin: Word): Longint; override;
750      procedure SetSize(NewSize: Longint); override;
# Line 615 | Line 769 | DefaultFieldClasses: array[TFieldType] o
769      TVarBytesField,     { ftVarBytes }
770      TAutoIncField,      { ftAutoInc }
771      TBlobField,         { ftBlob }
772 <    TMemoField,         { ftMemo }
772 >    TIBMemoField,       { ftMemo }
773      TGraphicField,      { ftGraphic }
774      TBlobField,         { ftFmtMemo }
775      TBlobField,         { ftParadoxOle }
# Line 623 | Line 777 | DefaultFieldClasses: array[TFieldType] o
777      TBlobField,         { ftTypedBinary }
778      nil,                { ftCursor }
779      TStringField,       { ftFixedChar }
780 <    TWideStringField,    { ftWideString }
780 >    TIBWideStringField,    { ftWideString }
781      TLargeIntField,     { ftLargeInt }
782      nil,          { ftADT }
783      nil,        { ftArray }
# Line 638 | Line 792 | DefaultFieldClasses: array[TFieldType] o
792      TDateTimeField,    {ftTimestamp}
793      TIBBCDField,       {ftFMTBcd}
794      nil,  {ftFixedWideChar}
795 <    TWideMemoField);   {ftWideMemo}
795 >    TIBWideMemoField);   {ftWideMemo}
796   (*
797      TADTField,          { ftADT }
798      TArrayField,        { ftArray }
# Line 655 | Line 809 | DefaultFieldClasses: array[TFieldType] o
809  
810   implementation
811  
812 < uses IBIntf, Variants, FmtBCD;
812 > uses IBIntf, Variants, FmtBCD, LazUTF8;
813  
814   const FILE_BEGIN = 0;
815        FILE_CURRENT = 1;
# Line 678 | Line 832 | type
832      NextRelation : TRelationNode;
833    end;
834  
835 +  {Extended Field Def for character set info}
836  
837 < { TIBStringField}
837 >  { TIBFieldDef }
838 >
839 >  TIBFieldDef = class(TFieldDef)
840 >  private
841 >    FCharacterSetName: RawByteString;
842 >    FCharacterSetSize: integer;
843 >    {$IFDEF HAS_ANSISTRING_CODEPAGE}
844 >    FCodePage: TSystemCodePage;
845 >    {$ENDIF}
846 >  published
847 >    property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
848 >    property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
849 >    {$IFDEF HAS_ANSISTRING_CODEPAGE}
850 >    property CodePage: TSystemCodePage read FCodePage write FCodePage;
851 >    {$ENDIF}
852 >  end;
853 >
854 >
855 >  {  Copied from LCLProc in order to avoid LCL dependency
856 >
857 >    Ensures the covenient look of multiline string
858 >    when displaying it in the single line
859 >    * Replaces CR and LF with spaces
860 >    * Removes duplicate spaces
861 >  }
862 >  function TextToSingleLine(const AText: string): string;
863 >  var
864 >    str: string;
865 >    i, wstart, wlen: Integer;
866 >  begin
867 >    str := Trim(AText);
868 >    wstart := 0;
869 >    wlen := 0;
870 >    i := 1;
871 >    while i < Length(str) - 1 do
872 >    begin
873 >      if (str[i] in [' ', #13, #10]) then
874 >      begin
875 >        if (wstart = 0) then
876 >        begin
877 >          wstart := i;
878 >          wlen := 1;
879 >        end else
880 >          Inc(wlen);
881 >      end else
882 >      begin
883 >        if wstart > 0 then
884 >        begin
885 >          str[wstart] := ' ';
886 >          Delete(str, wstart+1, wlen-1);
887 >          Dec(i, wlen-1);
888 >          wstart := 0;
889 >        end;
890 >      end;
891 >      Inc(i);
892 >    end;
893 >    Result := str;
894 >  end;
895 >
896 > { TIBWideMemoField }
897 >
898 > function TIBWideMemoField.GetTruncatedText: string;
899 > begin
900 >  Result := GetAsString;
901 >
902 >  if Result <> '' then
903 >    if DisplayWidth = 0 then
904 >      Result := TextToSingleLine(Result)
905 >    else
906 >    if Length(Result) > DisplayWidth then {Show truncation with elipses}
907 >      Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
908 > end;
909 >
910 > function TIBWideMemoField.GetDefaultWidth: Longint;
911 > begin
912 >  Result := 128;
913 > end;
914 >
915 > procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
916 > begin
917 >  if ADisplayText then
918 >  begin
919 >    if not DisplayTextAsClassName and (CharacterSetName<> '') then
920 >      AText := GetTruncatedText
921 >    else
922 >      inherited GetText(AText, ADisplayText);
923 >  end
924 >  else
925 >    AText := GetAsString;
926 > end;
927 >
928 > constructor TIBWideMemoField.Create(AOwner: TComponent);
929 > begin
930 >  inherited Create(AOwner);
931 >  BlobType := ftWideMemo;
932 > end;
933 >
934 > { TIBMemoField }
935 >
936 > function TIBMemoField.GetTruncatedText: string;
937 > begin
938 >   Result := GetAsString;
939 >
940 >   if Result <> '' then
941 >   begin
942 >       case CharacterSetSize of
943 >       1:
944 >         if DisplayWidth = 0 then
945 >           Result := TextToSingleLine(Result)
946 >         else
947 >         if Length(Result) > DisplayWidth then {Show truncation with elipses}
948 >           Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
949 >
950 >       {2: case 2 ignored. This should be handled by TIBWideMemo}
951 >
952 >       3, {Assume UNICODE_FSS is really UTF8}
953 >       4: {Include GB18030 - assuming UTF8 routine work for this codeset}
954 >         if DisplayWidth = 0 then
955 >           Result := ValidUTF8String(TextToSingleLine(Result))
956 >         else
957 >         if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
958 >           Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
959 >       end;
960 >   end
961 > end;
962 >
963 > function TIBMemoField.GetAsString: string;
964 > var s: RawByteString;
965 > begin
966 >  s := inherited GetAsString;
967 >  {$IFDEF HAS_ANSISTRING_CODEPAGE}
968 >  SetCodePage(s,CodePage,false);
969 >  {$ENDIF}
970 >  Result := s;
971 > end;
972 >
973 > function TIBMemoField.GetDefaultWidth: Longint;
974 > begin
975 >  if DisplayTextAsClassName then
976 >    Result := inherited
977 >  else
978 >    Result := 128;
979 > end;
980  
981 < constructor TIBStringField.Create(AOwner: TComponent);
981 > procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
982 > begin
983 >  if ADisplayText then
984 >  begin
985 >    if not DisplayTextAsClassName and (CharacterSetName <> '') then
986 >      AText := GetTruncatedText
987 >    else
988 >      inherited GetText(AText, ADisplayText);
989 >  end
990 >  else
991 >    AText := GetAsString;
992 > end;
993 >
994 > procedure TIBMemoField.SetAsString(const AValue: string);
995 > var s: RawByteString;
996 > begin
997 >  s := AValue;
998 >  {$IFDEF HAS_ANSISTRING_CODEPAGE}
999 >  if StringCodePage(Value) <> CodePage then
1000 >    SetCodePage(s,CodePage,true);
1001 >  {$ENDIF}
1002 >  inherited SetAsString(s);
1003 > end;
1004 >
1005 > constructor TIBMemoField.Create(AOwner: TComponent);
1006   begin
1007    inherited Create(AOwner);
1008 +  BlobType := ftMemo;
1009 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1010 +  FCodePage := CP_NONE;
1011 +  {$ENDIF}
1012 + end;
1013 +
1014 + { TIBControlLink }
1015 +
1016 + destructor TIBControlLink.Destroy;
1017 + begin
1018 +  IBDataSet := nil;
1019 +  inherited Destroy;
1020 + end;
1021 +
1022 + procedure TIBControlLink.UpdateParams(Sender: TObject);
1023 + begin
1024 +
1025 + end;
1026 +
1027 + procedure TIBControlLink.UpdateSQL(Sender: TObject);
1028 + begin
1029 +
1030 + end;
1031 +
1032 + procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1033 + begin
1034 +  if FTIBDataSet = AValue then Exit;
1035 +  if IBDataSet <> nil then
1036 +    IBDataSet.UnRegisterIBLink(self);
1037 +  FTIBDataSet := AValue;
1038 +  if IBDataSet <> nil then
1039 +    IBDataSet.RegisterIBLink(self);
1040 + end;
1041 +
1042 +
1043 + { TIBStringField}
1044 +
1045 + function TIBStringField.GetDefaultWidth: Longint;
1046 + begin
1047 +  Result := Size div CharacterSetSize;
1048 + end;
1049 +
1050 + constructor TIBStringField.Create(aOwner: TComponent);
1051 + begin
1052 +  inherited Create(aOwner);
1053 +  FCharacterSetSize := 1;
1054 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
1055 +  FCodePage := CP_NONE;
1056 +  {$ENDIF}
1057   end;
1058  
1059   class procedure TIBStringField.CheckTypeSize(Value: Integer);
# Line 706 | Line 1076 | end;
1076   function TIBStringField.GetValue(var Value: string): Boolean;
1077   var
1078    Buffer: PChar;
1079 +  s: RawByteString;
1080   begin
1081    Buffer := nil;
1082    IBAlloc(Buffer, 0, Size + 1);
# Line 713 | Line 1084 | begin
1084      Result := GetData(Buffer);
1085      if Result then
1086      begin
1087 +      {$IFDEF HAS_ANSISTRING_CODEPAGE}
1088 +      s := string(Buffer);
1089 +      SetCodePage(s,CodePage,false);
1090 +      Value := s;
1091 + //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1092 +      {$ELSE}
1093        Value := string(Buffer);
1094 +      {$ENDIF}
1095        if Transliterate and (Value <> '') then
1096          DataSet.Translate(PChar(Value), PChar(Value), False);
1097      end
# Line 725 | Line 1103 | end;
1103   procedure TIBStringField.SetAsString(const Value: string);
1104   var
1105    Buffer: PChar;
1106 +  s: RawByteString;
1107   begin
1108    Buffer := nil;
1109    IBAlloc(Buffer, 0, Size + 1);
1110    try
1111 <    StrLCopy(Buffer, PChar(Value), Size);
1111 >    s := Value;
1112 >    {$IFDEF HAS_ANSISTRING_CODEPAGE}
1113 >    if StringCodePage(s) <> CodePage then
1114 >      SetCodePage(s,CodePage,true);
1115 >    {$ENDIF}
1116 >    StrLCopy(Buffer, PChar(s), Size);
1117      if Transliterate then
1118        DataSet.Translate(Buffer, Buffer, True);
1119      SetData(Buffer);
# Line 738 | Line 1122 | begin
1122    end;
1123   end;
1124  
1125 +
1126   { TIBBCDField }
1127  
1128   constructor TIBBCDField.Create(AOwner: TComponent);
# Line 835 | Line 1220 | begin
1220    CheckIBLoaded;
1221    FIBLoaded := True;
1222    FBase := TIBBase.Create(Self);
1223 +  FIBLinks := TList.Create;
1224    FCurrentRecord := -1;
1225    FDeletedRecords := 0;
1226    FUniDirectional := False;
# Line 853 | Line 1239 | begin
1239    FQRefresh.GoToFirstRecordOnExecute := False;
1240    FQSelect := TIBSQL.Create(Self);
1241    FQSelect.OnSQLChanging := SQLChanging;
1242 +  FQSelect.OnSQLChanged := SQLChanged;
1243    FQSelect.GoToFirstRecordOnExecute := False;
1244    FQModify := TIBSQL.Create(Self);
1245    FQModify.OnSQLChanging := SQLChanging;
1246    FQModify.GoToFirstRecordOnExecute := False;
1247    FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1248    FParamCheck := True;
1249 +  FGenerateParamNames := False;
1250    FForcedRefresh := False;
1251 +  FAutoCommit:= acDisabled;
1252 +  FDataSetCloseAction := dcDiscardChanges;
1253    {Bookmark Size is Integer for IBX}
1254    BookmarkSize := SizeOf(Integer);
1255    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
# Line 873 | Line 1263 | begin
1263    else
1264      if AOwner is TIBTransaction then
1265        Transaction := TIBTransaction(AOwner);
1266 +  FBaseSQLSelect := TStringList.Create;
1267   end;
1268  
1269   destructor TIBCustomDataSet.Destroy;
# Line 884 | Line 1275 | begin
1275      FDataLink.Free;
1276      FBase.Free;
1277      ClearBlobCache;
1278 +    ClearIBLinks;
1279 +    FIBLinks.Free;
1280      FBlobStreamList.Free;
1281      FreeMem(FBufferCache);
1282      FBufferCache := nil;
# Line 893 | Line 1286 | begin
1286      FOldCacheSize := 0;
1287      FMappedFieldPosition := nil;
1288    end;
1289 +  if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1290 +  if assigned(FParser) then FParser.Free;
1291    inherited Destroy;
1292   end;
1293  
# Line 934 | Line 1329 | end;
1329  
1330   procedure TIBCustomDataSet.ApplyUpdates;
1331   var
1332 <  {$IF FPC_FULLVERSION > 20600 }
1332 >  {$IFDEF NEW_TBOOKMARK }
1333    CurBookmark: TBookmark;
1334    {$ELSE}
1335    CurBookmark: string;
# Line 1136 | Line 1531 | begin
1531    end;
1532   end;
1533  
1534 + function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1535 + var i: integer;
1536 +    Prepared: boolean;
1537 + begin
1538 +  Result := 0;
1539 +  Prepared := FInternalPrepared;
1540 +  if not Prepared then
1541 +    InternalPrepare;
1542 +  try
1543 +    for i := 0 to Length(FAliasNameList) - 1 do
1544 +      if FAliasNameList[i] = AliasName then
1545 +      begin
1546 +        Result := i + 1;
1547 +        Exit
1548 +      end;
1549 +  finally
1550 +    if not Prepared then
1551 +      InternalUnPrepare;
1552 +  end;
1553 + end;
1554 +
1555   procedure TIBCustomDataSet.ActivateConnection;
1556   begin
1557    if not Assigned(Database) then
# Line 1196 | Line 1612 | begin
1612      IBError(ibxeDatasetClosed, [nil]);
1613   end;
1614  
1615 + function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1616 + begin
1617 +  Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1618 +  Result.OnSQLChanging := SQLChanging
1619 + end;
1620 +
1621   procedure TIBCustomDataSet.CheckNotUniDirectional;
1622   begin
1623    if UniDirectional then
# Line 1299 | Line 1721 | begin
1721      FDatabaseFree(Sender);
1722   end;
1723  
1724 < procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1724 > procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1725 >  Action: TTransactionAction);
1726   begin
1727 <  if Active then
1728 <    Active := False;
1727 >  FCloseAction := Action;
1728 >  FInTransactionEnd := true;
1729 >  try
1730 >    if Active then
1731 >      Active := False;
1732 >  finally
1733 >    FInTransactionEnd := false;
1734 >  end;
1735    if FQSelect <> nil then
1736      FQSelect.FreeHandle;
1737    if FQDelete <> nil then
# Line 1340 | Line 1769 | var
1769    LocalData: Pointer;
1770    LocalDate, LocalDouble: Double;
1771    LocalInt: Integer;
1772 +  LocalBool: wordBool;
1773    LocalInt64: Int64;
1774    LocalCurrency: Currency;
1775    FieldsLoaded: Integer;
# Line 1484 | Line 1914 | begin
1914              end;
1915            end;
1916          end;
1917 +        SQL_BOOLEAN:
1918 +        begin
1919 +          LocalBool:= false;
1920 +          rdFields[j].fdDataSize := SizeOf(wordBool);
1921 +          if RecordNumber >= 0 then
1922 +            LocalBool := Qry.Current[i].AsBoolean;
1923 +          LocalData := PChar(@LocalBool);
1924 +        end;
1925          else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1926          begin
1927            rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
# Line 1626 | Line 2064 | function TIBCustomDataSet.InternalLocate
2064    const KeyValues: Variant; Options: TLocateOptions): Boolean;
2065   var
2066    keyFieldList: TList;
2067 <  {$IF FPC_FULLVERSION > 20600 }
2067 >  {$IFDEF NEW_TBOOKMARK }
2068    CurBookmark: TBookmark;
2069    {$ELSE}
2070    CurBookmark: string;
# Line 1755 | Line 2193 | end;
2193   procedure TIBCustomDataSet.InternalRefreshRow;
2194   var
2195    Buff: PChar;
1758  SetCursor: Boolean;
2196    ofs: DWORD;
2197    Qry: TIBSQL;
2198   begin
2199 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1763 <  if SetCursor then
1764 <    Screen.Cursor := crHourGlass;
2199 >  FBase.SetCursor;
2200    try
2201      Buff := GetActiveBuf;
2202      if CanRefresh then
# Line 1805 | Line 2240 | begin
2240      else
2241        IBError(ibxeCannotRefresh, [nil]);
2242    finally
2243 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1809 <      Screen.Cursor := crDefault;
2243 >    FBase.RestoreCursor;
2244    end;
2245   end;
2246  
# Line 1877 | Line 2311 | end;
2311  
2312   procedure TIBCustomDataSet.InternalPrepare;
2313   var
1880  SetCursor: Boolean;
2314    DidActivate: Boolean;
2315   begin
2316    if FInternalPrepared then
2317      Exit;
2318    DidActivate := False;
2319 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1887 <  if SetCursor then
1888 <    Screen.Cursor := crHourGlass;
2319 >  FBase.SetCursor;
2320    try
2321      ActivateConnection;
2322      DidActivate := ActivateTransaction;
2323      FBase.CheckDatabase;
2324      FBase.CheckTransaction;
2325 +    if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2326 +    begin
2327 +      FQSelect.OnSQLChanged := nil; {Do not react to change}
2328 +      try
2329 +        FQSelect.SQL.Text := FParser.SQLText;
2330 +      finally
2331 +        FQSelect.OnSQLChanged := SQLChanged;
2332 +      end;
2333 +    end;
2334 + //   writeln( FQSelect.SQL.Text);
2335      if FQSelect.SQL.Text <> '' then
2336      begin
2337        if not FQSelect.Prepared then
2338        begin
2339 +        FQSelect.GenerateParamNames := FGenerateParamNames;
2340          FQSelect.ParamCheck := ParamCheck;
2341          FQSelect.Prepare;
2342        end;
2343 +      FQDelete.GenerateParamNames := FGenerateParamNames;
2344        if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2345          FQDelete.Prepare;
2346 +      FQInsert.GenerateParamNames := FGenerateParamNames;
2347        if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2348          FQInsert.Prepare;
2349 +      FQRefresh.GenerateParamNames := FGenerateParamNames;
2350        if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2351          FQRefresh.Prepare;
2352 +      FQModify.GenerateParamNames := FGenerateParamNames;
2353        if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2354          FQModify.Prepare;
2355        FInternalPrepared := True;
# Line 1913 | Line 2359 | begin
2359    finally
2360      if DidActivate then
2361        DeactivateTransaction;
2362 <    if SetCursor and (Screen.Cursor = crHourGlass) then
1917 <      Screen.Cursor := crDefault;
2362 >    FBase.RestoreCursor;
2363    end;
2364   end;
2365  
# Line 2105 | Line 2550 | begin
2550              SQL_TIMESTAMP:
2551                Qry.Params[i].AsDateTime :=
2552                         TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2553 +            SQL_BOOLEAN:
2554 +              Qry.Params[i].AsBoolean := PWordBool(data)^;
2555            end;
2556          end;
2557        end;
# Line 2190 | Line 2637 | begin
2637    end;
2638   end;
2639  
2640 + procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2641 + begin
2642 +  if FIBLinks.IndexOf(Sender) = -1 then
2643 +    FIBLinks.Add(Sender);
2644 + end;
2645 +
2646  
2647   procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2648   begin
2649 <  if FOpen then
2650 <    InternalClose;
2649 >  Active := false;
2650 > {  if FOpen then
2651 >    InternalClose;}
2652    if FInternalPrepared then
2653      InternalUnPrepare;
2654 +  FieldDefs.Clear;
2655 +  FieldDefs.Updated := false;
2656 + end;
2657 +
2658 + procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2659 + begin
2660 +  FBaseSQLSelect.assign(FQSelect.SQL);
2661   end;
2662  
2663   { I can "undelete" uninserted records (make them "inserted" again).
# Line 2225 | Line 2686 | begin
2686    end;
2687   end;
2688  
2689 + procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2690 + begin
2691 +  FIBLinks.Remove(Sender);
2692 + end;
2693 +
2694   function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2695   begin
2696    if Active then
# Line 2454 | Line 2920 | begin
2920    inherited DoBeforeDelete;
2921   end;
2922  
2923 + procedure TIBCustomDataSet.DoAfterDelete;
2924 + begin
2925 +  inherited DoAfterDelete;
2926 +  FBase.DoAfterDelete(self);
2927 +  InternalAutoCommit;
2928 + end;
2929 +
2930   procedure TIBCustomDataSet.DoBeforeEdit;
2931   var
2932    Buff: PRecordData;
# Line 2468 | Line 2941 | begin
2941    inherited DoBeforeEdit;
2942   end;
2943  
2944 + procedure TIBCustomDataSet.DoAfterEdit;
2945 + begin
2946 +  inherited DoAfterEdit;
2947 +  FBase.DoAfterEdit(self);
2948 + end;
2949 +
2950   procedure TIBCustomDataSet.DoBeforeInsert;
2951   begin
2952    if not CanInsert then
# Line 2480 | Line 2959 | begin
2959    if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2960      GeneratorField.Apply;
2961    inherited DoAfterInsert;
2962 +  FBase.DoAfterInsert(self);
2963 + end;
2964 +
2965 + procedure TIBCustomDataSet.DoBeforeClose;
2966 + begin
2967 +  inherited DoBeforeClose;
2968 +  if State in [dsInsert,dsEdit] then
2969 +  begin
2970 +    if FInTransactionEnd and (FCloseAction = TARollback) then
2971 +       Exit;
2972 +
2973 +    if DataSetCloseAction = dcSaveChanges then
2974 +      Post;
2975 +      {Note this can fail with an exception e.g. due to
2976 +       database validation error. In which case the dataset remains open }
2977 +  end;
2978 + end;
2979 +
2980 + procedure TIBCustomDataSet.DoBeforeOpen;
2981 + var i: integer;
2982 + begin
2983 +  if assigned(FParser) then
2984 +     FParser.Reset;
2985 +  for i := 0 to FIBLinks.Count - 1 do
2986 +    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2987 +  inherited DoBeforeOpen;
2988 +  for i := 0 to FIBLinks.Count - 1 do
2989 +    TIBControlLink(FIBLinks[i]).UpdateParams(self);
2990   end;
2991  
2992   procedure TIBCustomDataSet.DoBeforePost;
# Line 2490 | Line 2997 | begin
2997       GeneratorField.Apply
2998   end;
2999  
3000 + procedure TIBCustomDataSet.DoAfterPost;
3001 + begin
3002 +  inherited DoAfterPost;
3003 +  FBase.DoAfterPost(self);
3004 +  InternalAutoCommit;
3005 + end;
3006 +
3007   procedure TIBCustomDataSet.FetchAll;
3008   var
3009 <  SetCursor: Boolean;
2496 <  {$IF FPC_FULLVERSION > 20600 }
3009 >  {$IFDEF NEW_TBOOKMARK }
3010    CurBookmark: TBookmark;
3011    {$ELSE}
3012    CurBookmark: string;
3013    {$ENDIF}
3014   begin
3015 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3016 <  if SetCursor then
2504 <    Screen.Cursor := crHourGlass;
2505 <  try
3015 >  FBase.SetCursor;
3016 > try
3017      if FQSelect.EOF or not FQSelect.Open then
3018        exit;
3019      DisableControls;
# Line 2514 | Line 3025 | begin
3025        EnableControls;
3026      end;
3027    finally
3028 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2518 <      Screen.Cursor := crDefault;
3028 >    FBase.RestoreCursor;
3029    end;
3030   end;
3031  
# Line 2563 | Line 3073 | begin
3073      result := FDataLink.DataSource;
3074   end;
3075  
3076 + function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3077 + begin
3078 +  Result := FAliasNameMap[FieldNo-1]
3079 + end;
3080 +
3081 + function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3082 + var
3083 +   i: integer;
3084 + begin
3085 +   Result := nil;
3086 +   for i := 0 to Length(FAliasNameMap) - 1 do
3087 +       if FAliasNameMap[i] = aliasName then
3088 +       begin
3089 +         Result := FieldDefs[i];
3090 +         Exit
3091 +       end;
3092 + end;
3093 +
3094   function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3095   begin
3096    Result := DefaultFieldClasses[FieldType];
# Line 2603 | Line 3131 | begin
3131          Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3132          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3133          begin
3134 <          if fdDataLength <= Field.Size then
3134 >          if fdDataLength < Field.DataSize then
3135            begin
3136              Move(Data^, Buffer^, fdDataLength);
3137              PChar(Buffer)[fdDataLength] := #0;
# Line 2652 | Line 3180 | begin
3180          if not Accept and (GetMode = gmCurrent) then
3181            GetMode := gmPrior;
3182        except
3183 < //        Application.HandleException(Self);
3183 > //        FBase.HandleException(Self);
3184        end;
3185      end;
3186      RestoreState(SaveState);
# Line 2746 | Line 3274 | begin
3274    result := FRecordBufferSize;
3275   end;
3276  
3277 + procedure TIBCustomDataSet.InternalAutoCommit;
3278 + begin
3279 +  with Transaction do
3280 +    if InTransaction and (FAutoCommit = acCommitRetaining) then
3281 +    begin
3282 +      if CachedUpdates then ApplyUpdates;
3283 +      CommitRetaining;
3284 +    end;
3285 + end;
3286 +
3287   procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3288   begin
3289    CheckEditState;
# Line 2817 | Line 3355 | begin
3355    FreeMem(FOldBufferCache);
3356    FOldBufferCache := nil;
3357    BindFields(False);
3358 +  ResetParser;
3359    if DefaultFields then DestroyFields;
3360   end;
3361  
3362   procedure TIBCustomDataSet.InternalDelete;
3363   var
3364    Buff: PChar;
2826  SetCursor: Boolean;
3365   begin
3366 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2829 <  if SetCursor then
2830 <    Screen.Cursor := crHourGlass;
3366 >  FBase.SetCursor;
3367    try
3368      Buff := GetActiveBuf;
3369      if CanDelete then
# Line 2852 | Line 3388 | begin
3388      end else
3389        IBError(ibxeCannotDelete, [nil]);
3390    finally
3391 <    if SetCursor and (Screen.Cursor = crHourGlass) then
2856 <      Screen.Cursor := crDefault;
3391 >    FBase.RestoreCursor;
3392    end;
3393   end;
3394  
# Line 2869 | Line 3404 | end;
3404  
3405   procedure TIBCustomDataSet.InternalHandleException;
3406   begin
3407 <  Application.HandleException(Self)
3407 >  FBase.HandleException(Self)
3408   end;
3409  
3410   procedure TIBCustomDataSet.InternalInitFieldDefs;
3411 + begin
3412 +  if not InternalPrepared then
3413 +  begin
3414 +    InternalPrepare;
3415 +    exit;
3416 +  end;
3417 +   FieldDefsFromQuery(FQSelect);
3418 + end;
3419 +
3420 + procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3421   const
3422    DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3423                 'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
# Line 2884 | Line 3429 | const
3429   var
3430    FieldType: TFieldType;
3431    FieldSize: Word;
3432 +  charSetID: short;
3433 +  CharSetSize: integer;
3434 +  CharSetName: RawByteString;
3435 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
3436 +  FieldCodePage: TSystemCodePage;
3437 +  {$ENDIF}
3438    FieldNullable : Boolean;
3439    i, FieldPosition, FieldPrecision: Integer;
3440 <  FieldAliasName: string;
3440 >  FieldAliasName, DBAliasName: string;
3441    RelationName, FieldName: string;
3442    Query : TIBSQL;
3443    FieldIndex: Integer;
# Line 2986 | Line 3537 | var
3537    end;
3538  
3539   begin
2989  if not InternalPrepared then
2990  begin
2991    InternalPrepare;
2992    exit;
2993  end;
3540    FRelationNodes := TRelationNode.Create;
3541    FNeedsRefresh := False;
3542    Database.InternalTransaction.StartTransaction;
# Line 3001 | Line 3547 | begin
3547      FieldDefs.BeginUpdate;
3548      FieldDefs.Clear;
3549      FieldIndex := 0;
3550 <    if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3551 <      SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3550 >    if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3551 >      SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3552      Query.SQL.Text := DefaultSQL;
3553      Query.Prepare;
3554 <    for i := 0 to FQSelect.Current.Count - 1 do
3555 <      with FQSelect.Current[i].Data^ do
3554 >    SetLength(FAliasNameMap, SourceQuery.Current.Count);
3555 >    SetLength(FAliasNameList, SourceQuery.Current.Count);
3556 >    for i := 0 to SourceQuery.Current.Count - 1 do
3557 >      with SourceQuery.Current[i].Data^ do
3558        begin
3559          { Get the field name }
3560 <        SetString(FieldAliasName, aliasname, aliasname_length);
3560 >        FieldAliasName := SourceQuery.Current[i].Name;
3561 >        SetString(DBAliasName, aliasname, aliasname_length);
3562          SetString(RelationName, relname, relname_length);
3563          SetString(FieldName, sqlname, sqlname_length);
3564 +        FAliasNameList[i] := DBAliasName;
3565          FieldSize := 0;
3566          FieldPrecision := 0;
3567 <        FieldNullable := FQSelect.Current[i].IsNullable;
3567 >        FieldNullable := SourceQuery.Current[i].IsNullable;
3568 >        CharSetSize := 0;
3569 >        CharSetName := '';
3570 >        {$IFDEF HAS_ANSISTRING_CODEPAGE}
3571 >        FieldCodePage := CP_NONE;
3572 >        {$ENDIF}
3573          case sqltype and not 1 of
3574            { All VARCHAR's must be converted to strings before recording
3575             their values }
3576            SQL_VARYING, SQL_TEXT:
3577            begin
3578 +            CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3579 +            CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3580 +            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3581 +            FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
3582 +            {$ENDIF}
3583 +            {FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3584              FieldSize := sqllen;
3585 <            FieldType := ftString;
3585 >            if CharSetSize = 2 then
3586 >              FieldType := ftWideString
3587 >            else
3588 >              FieldType := ftString;
3589            end;
3590            { All Doubles/Floats should be cast to doubles }
3591            SQL_DOUBLE, SQL_FLOAT:
# Line 3080 | Line 3644 | begin
3644            begin
3645              FieldSize := sizeof (TISC_QUAD);
3646              if (sqlsubtype = 1) then
3647 <              FieldType := ftmemo
3647 >            begin
3648 >              if FBase.GetDefaultCharSetName <> '' then
3649 >              begin
3650 >                CharSetSize := FBase.GetDefaultCharSetSize;
3651 >                CharSetName := FBase.GetDefaultCharSetName;
3652 >                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3653 >                FieldCodePage := FBase.GetDefaultCodePage;
3654 >                {$ENDIF}
3655 >              end
3656 >              else
3657 >              if strpas(sqlname) <> '' then
3658 >              begin
3659 >                charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3660 >                        @relname,@sqlname);
3661 >                CharSetSize := FBase.GetCharSetSize(charSetID);
3662 >                CharSetName := FBase.GetCharSetName(charSetID);
3663 >                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3664 >                FieldCodePage := FBase.GetCodePage(charSetID);
3665 >                {$ENDIF}
3666 >             end
3667 >              else  {Complex SQL with no identifiable column and no connection default}
3668 >              begin
3669 >                CharSetName := '';
3670 >                CharSetSize := 1;
3671 >                {$IFDEF HAS_ANSISTRING_CODEPAGE}
3672 >                FieldCodePage := CP_NONE;
3673 >                {$ENDIF}
3674 >              end;
3675 >              if CharSetSize = 2 then
3676 >                FieldType := ftWideMemo
3677 >              else
3678 >                FieldType := ftMemo;
3679 >            end
3680              else
3681                FieldType := ftBlob;
3682            end;
# Line 3089 | Line 3685 | begin
3685              FieldSize := sizeof (TISC_QUAD);
3686              FieldType := ftUnknown;
3687            end;
3688 +          SQL_BOOLEAN:
3689 +             FieldType:= ftBoolean;
3690            else
3691              FieldType := ftUnknown;
3692          end;
# Line 3097 | Line 3695 | begin
3695          begin
3696            FMappedFieldPosition[FieldIndex] := FieldPosition;
3697            Inc(FieldIndex);
3698 <          with FieldDefs.AddFieldDef do
3698 >          with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3699            begin
3700              Name := FieldAliasName;
3701 < (*           FieldNo := FieldPosition;*)
3104 <            DataType := FieldType;
3701 >            FAliasNameMap[FieldNo-1] := DBAliasName;
3702              Size := FieldSize;
3703              Precision := FieldPrecision;
3704              Required := not FieldNullable;
3705              InternalCalcField := False;
3706 +            CharacterSetSize := CharSetSize;
3707 +            CharacterSetName := CharSetName;
3708 +            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3709 +            CodePage := FieldCodePage;
3710 +            {$ENDIF}
3711              if (FieldName <> '') and (RelationName <> '') then
3712              begin
3713                if Has_COMPUTED_BLR(RelationName, FieldName) then
# Line 3185 | Line 3787 | begin
3787          else case cur_field.DataType of
3788            ftString:
3789              cur_param.AsString := cur_field.AsString;
3790 <          ftBoolean, ftSmallint, ftWord:
3790 >          ftBoolean:
3791 >            cur_param.AsBoolean := cur_field.AsBoolean;
3792 >          ftSmallint, ftWord:
3793              cur_param.AsShort := cur_field.AsInteger;
3794            ftInteger:
3795              cur_param.AsLong := cur_field.AsInteger;
# Line 3238 | Line 3842 | begin
3842   end;
3843  
3844   procedure TIBCustomDataSet.InternalOpen;
3241 var
3242  SetCursor: Boolean;
3845  
3846    function RecordDataLength(n: Integer): Long;
3847    begin
3848      result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3849    end;
3850  
3851 +  function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3852 +  var i: integer;
3853 +  begin
3854 +    Result := nil;
3855 +    for i := 0 to FieldDefs.Count - 1 do
3856 +      if FieldDefs[i].FieldNo = aFieldNo then
3857 +      begin
3858 +        Result := TIBFieldDef(FieldDefs[i]);
3859 +        break;
3860 +      end;
3861 +  end;
3862 +
3863 +  procedure SetExtendedProperties;
3864 +  var i: integer;
3865 +      IBFieldDef: TIBFieldDef;
3866 +  begin
3867 +    for i := 0 to Fields.Count - 1 do
3868 +      if Fields[i].FieldNo > 0 then
3869 +      begin
3870 +        if(Fields[i] is TIBStringField) then
3871 +        with TIBStringField(Fields[i]) do
3872 +        begin
3873 +          IBFieldDef := GetFieldDef(FieldNo);
3874 +          if IBFieldDef <> nil then
3875 +          begin
3876 +            CharacterSetSize := IBFieldDef.CharacterSetSize;
3877 +            CharacterSetName := IBFieldDef.CharacterSetName;
3878 +            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3879 +            CodePage := IBFieldDef.CodePage;
3880 +            {$ENDIF}
3881 +          end;
3882 +        end
3883 +        else
3884 +        if(Fields[i] is TIBWideStringField) then
3885 +        with TIBWideStringField(Fields[i]) do
3886 +        begin
3887 +          IBFieldDef := GetFieldDef(FieldNo);
3888 +          if IBFieldDef <> nil then
3889 +          begin
3890 +            CharacterSetSize := IBFieldDef.CharacterSetSize;
3891 +            CharacterSetName := IBFieldDef.CharacterSetName;
3892 +          end;
3893 +        end
3894 +        else
3895 +        if(Fields[i] is TIBMemoField) then
3896 +        with TIBMemoField(Fields[i]) do
3897 +        begin
3898 +          IBFieldDef := GetFieldDef(FieldNo);
3899 +          if IBFieldDef <> nil then
3900 +          begin
3901 +            CharacterSetSize := IBFieldDef.CharacterSetSize;
3902 +            CharacterSetName := IBFieldDef.CharacterSetName;
3903 +            {$IFDEF HAS_ANSISTRING_CODEPAGE}
3904 +            CodePage := IBFieldDef.CodePage;
3905 +            {$ENDIF}
3906 +          end;
3907 +        end
3908 +        else
3909 +        if(Fields[i] is TIBWideMemoField) then
3910 +        with TIBWideMemoField(Fields[i]) do
3911 +        begin
3912 +          IBFieldDef := GetFieldDef(FieldNo);
3913 +          if IBFieldDef <> nil then
3914 +          begin
3915 +            CharacterSetSize := IBFieldDef.CharacterSetSize;
3916 +            CharacterSetName := IBFieldDef.CharacterSetName;
3917 +          end;
3918 +        end
3919 +      end
3920 +  end;
3921 +
3922   begin
3923 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3251 <  if SetCursor then
3252 <    Screen.Cursor := crHourGlass;
3923 >  FBase.SetCursor;
3924    try
3925      ActivateConnection;
3926      ActivateTransaction;
# Line 3262 | Line 3933 | begin
3933        if DefaultFields then
3934          CreateFields;
3935        BindFields(True);
3936 +      SetExtendedProperties;
3937        FCurrentRecord := -1;
3938        FQSelect.ExecQuery;
3939        FOpen := FQSelect.Open;
# Line 3310 | Line 3982 | begin
3982      else
3983        FQSelect.ExecQuery;
3984    finally
3985 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3314 <      Screen.Cursor := crDefault;
3985 >    FBase.RestoreCursor;
3986    end;
3987   end;
3988  
# Line 3319 | Line 3990 | procedure TIBCustomDataSet.InternalPost;
3990   var
3991    Qry: TIBSQL;
3992    Buff: PChar;
3322  SetCursor: Boolean;
3993    bInserting: Boolean;
3994   begin
3995 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3326 <  if SetCursor then
3327 <    Screen.Cursor := crHourGlass;
3995 >  FBase.SetCursor;
3996    try
3997      Buff := GetActiveBuf;
3998      CheckEditState;
# Line 3362 | Line 4030 | begin
4030      if bInserting then
4031        Inc(FRecordCount);
4032    finally
4033 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3366 <      Screen.Cursor := crDefault;
4033 >    FBase.RestoreCursor;
4034    end;
4035   end;
4036  
# Line 3383 | Line 4050 | begin
4050    result := FOpen;
4051   end;
4052  
4053 + procedure TIBCustomDataSet.Loaded;
4054 + begin
4055 +  if assigned(FQSelect) then
4056 +    FBaseSQLSelect.assign(FQSelect.SQL);
4057 +  inherited Loaded;
4058 + end;
4059 +
4060 + procedure TIBCustomDataSet.Post;
4061 + var CancelPost: boolean;
4062 + begin
4063 +  CancelPost := false;
4064 +  if assigned(FOnValidatePost) then
4065 +    OnValidatePost(self,CancelPost);
4066 +  if CancelPost then
4067 +    Cancel
4068 +  else
4069 +   inherited Post;
4070 + end;
4071 +
4072   function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4073                                   Options: TLocateOptions): Boolean;
4074   var
4075 <  {$IF FPC_FULLVERSION > 20600 }
4075 >  {$IFDEF NEW_TBOOKMARK }
4076    CurBookmark: TBookmark;
4077    {$ELSE}
4078    CurBookmark: string;
# Line 3408 | Line 4094 | function TIBCustomDataSet.Lookup(const K
4094                                   const ResultFields: string): Variant;
4095   var
4096    fl: TList;
4097 <  {$IF FPC_FULLVERSION > 20600 }
4097 >  {$IFDEF NEW_TBOOKMARK }
4098    CurBookmark: TBookmark;
4099    {$ELSE}
4100    CurBookmark: string;
# Line 3465 | Line 4151 | end;
4151   procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4152   var
4153    Buff, TmpBuff: PChar;
4154 +  MappedFieldPos: integer;
4155   begin
4156    Buff := GetActiveBuf;
4157    if Field.FieldNo < 0 then
# Line 3481 | Line 4168 | begin
4168      begin
4169        { If inserting, Adjust record position }
4170        AdjustRecordOnInsert(Buff);
4171 <      if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4172 <         (FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4171 >      MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4172 >      if (MappedFieldPos > 0) and
4173 >         (MappedFieldPos <= rdFieldCount) then
4174        begin
4175          Field.Validate(Buffer);
4176          if (Buffer = nil) or
4177             (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4178 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4178 >          rdFields[MappedFieldPos].fdIsNull := True
4179          else begin
4180 <          Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4181 <                 rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4182 <          if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4183 <             (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4184 <            rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4185 <          rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4180 >          Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4181 >                 rdFields[MappedFieldPos].fdDataSize);
4182 >          if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4183 >             (rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4184 >            rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4185 >          rdFields[MappedFieldPos].fdIsNull := False;
4186            if rdUpdateStatus = usUnmodified then
4187            begin
4188              if CachedUpdates then
# Line 3582 | Line 4270 | begin
4270   FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4271   end;
4272  
4273 + procedure TIBCustomDataSet.ClearIBLinks;
4274 + var i: integer;
4275 + begin
4276 +  for i := FIBLinks.Count - 1 downto 0 do
4277 +    TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4278 + end;
4279 +
4280  
4281   procedure TIBCustomDataSet.InternalUnPrepare;
4282   begin
# Line 3589 | Line 4284 | begin
4284    begin
4285      CheckDatasetClosed;
4286      FieldDefs.Clear;
4287 +    FieldDefs.Updated := false;
4288      FInternalPrepared := False;
4289 +    Setlength(FAliasNameList,0);
4290    end;
4291   end;
4292  
4293   procedure TIBCustomDataSet.InternalExecQuery;
4294   var
4295    DidActivate: Boolean;
3599  SetCursor: Boolean;
4296   begin
4297    DidActivate := False;
4298 <  SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3603 <  if SetCursor then
3604 <    Screen.Cursor := crHourGlass;
4298 >  FBase.SetCursor;
4299    try
4300      ActivateConnection;
4301      DidActivate := ActivateTransaction;
# Line 3618 | Line 4312 | begin
4312    finally
4313      if DidActivate then
4314        DeactivateTransaction;
4315 <    if SetCursor and (Screen.Cursor = crHourGlass) then
3622 <      Screen.Cursor := crDefault;
4315 >    FBase.RestoreCursor;
4316    end;
4317   end;
4318  
# Line 3628 | Line 4321 | begin
4321    Result := FQSelect.Handle;
4322   end;
4323  
4324 + function TIBCustomDataSet.GetParser: TSelectSQLParser;
4325 + begin
4326 +  if not assigned(FParser) then
4327 +    FParser := CreateParser;
4328 +  Result := FParser
4329 + end;
4330 +
4331 + procedure TIBCustomDataSet.ResetParser;
4332 + begin
4333 +  if assigned(FParser) then
4334 +  begin
4335 +    FParser.Free;
4336 +    FParser := nil;
4337 +    FQSelect.OnSQLChanged := nil; {Do not react to change}
4338 +    try
4339 +      FQSelect.SQL.Assign(FBaseSQLSelect);
4340 +    finally
4341 +      FQSelect.OnSQLChanged := SQLChanged;
4342 +    end;
4343 +  end;
4344 + end;
4345 +
4346 + function TIBCustomDataSet.HasParser: boolean;
4347 + begin
4348 +  Result := not (csDesigning in ComponentState) and (FParser <> nil)
4349 + end;
4350 +
4351 + procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4352 + begin
4353 +  if FGenerateParamNames = AValue then Exit;
4354 +  FGenerateParamNames := AValue;
4355 +  Disconnect
4356 + end;
4357 +
4358   procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4359   begin
4360    inherited InitRecord(Buffer);
# Line 3951 | Line 4678 | begin
4678    DataSet.SetInternalSQLParams(Query, buff);
4679   end;
4680  
4681 + function TIBDSBlobStream.GetSize: Int64;
4682 + begin
4683 +  Result := FBlobStream.BlobSize;
4684 + end;
4685 +
4686   { TIBDSBlobStream }
4687   constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4688                                      Mode: TBlobStreamMode);
# Line 3959 | Line 4691 | begin
4691    FBlobStream := ABlobStream;
4692    FBlobStream.Seek(0, soFromBeginning);
4693    if (Mode = bmWrite) then
4694 +  begin
4695      FBlobStream.Truncate;
4696 +    TIBCustomDataSet(FField.DataSet).RecordModified(True);
4697 +    TBlobField(FField).Modified := true;
4698 +    FHasWritten := true;
4699 +  end;
4700 + end;
4701 +
4702 + destructor TIBDSBlobStream.Destroy;
4703 + begin
4704 +  if FHasWritten then
4705 +     TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4706 +  inherited Destroy;
4707   end;
4708  
4709   function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
# Line 3984 | Line 4728 | begin
4728    TIBCustomDataSet(FField.DataSet).RecordModified(True);
4729    TBlobField(FField).Modified := true;
4730    result := FBlobStream.Write(Buffer, Count);
4731 <  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4731 >  FHasWritten := true;
4732 > {  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4733 >  Removed as this caused a seek to beginning of the blob stream thus corrupting
4734 >  the blob stream. Moved to the destructor i.e. called after blob written}
4735   end;
4736  
4737   { TIBGenerator }
# Line 4031 | Line 4778 | end;
4778  
4779   procedure TIBGenerator.Apply;
4780   begin
4781 <  if (FGeneratorName <> '') and (FFieldName <> '')  then
4781 >  if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4782      Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4783   end;
4784  
4785 +
4786   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines