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

Comparing ibx/trunk/runtime/nongui/IBCustomDataSet.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 311 by tony, Mon Aug 24 09:32:58 2020 UTC

# Line 399 | Line 399 | type
399      FArrayFieldCount: integer;
400      FArrayCacheOffset: integer;
401      FAutoCommit: TIBAutoCommit;
402 +    FCaseSensitiveParameterNames: boolean;
403      FEnableStatistics: boolean;
404      FGenerateParamNames: Boolean;
405      FGeneratorField: TIBGenerator;
# Line 440 | Line 441 | type
441      FRecordCount: Integer;
442      FRecordSize: Integer;
443      FDataSetCloseAction: TDataSetCloseAction;
444 +    FSQLFiltered: boolean;
445 +    FSQLFilterParams: TStrings;
446      FUniDirectional: Boolean;
447      FUpdateMode: TUpdateMode;
448      FUpdateObject: TIBDataSetUpdateObject;
# Line 474 | Line 477 | type
477        FieldIndex: integer; Buffer: PChar);
478      procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
479      function GetSelectStmtIntf: IStatement;
480 +    procedure SetCaseSensitiveParameterNames(AValue: boolean);
481 +    procedure SetSQLFiltered(AValue: boolean);
482 +    procedure SetSQLFilterParams(AValue: TStrings);
483      procedure SetUpdateMode(const Value: TUpdateMode);
484      procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
485  
# Line 507 | Line 513 | type
513      function GetModifySQL: TStrings;
514      function GetTransaction: TIBTransaction;
515      function GetParser: TSelectSQLParser;
516 +    procedure HandleSQLFilterParamsChanged(Sender: TObject);
517      procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
518      function InternalLocate(const KeyFields: string; const KeyValues: Variant;
519                              Options: TLocateOptions): Boolean; virtual;
# Line 591 | Line 598 | type
598      procedure DoBeforeInsert; override;
599      procedure DoAfterInsert; override;
600      procedure DoBeforeClose; override;
594 –    procedure DoBeforeOpen; override;
601      procedure DoBeforePost; override;
602      procedure DoAfterPost; override;
603      procedure FreeRecordBuffer(var Buffer: PChar); override;
# Line 652 | Line 658 | type
658      property SelectStmtHandle: IStatement read GetSelectStmtIntf;
659  
660      {Likely to be made published by descendant classes}
661 +    property CaseSensitiveParameterNames: boolean read FCaseSensitiveParameterNames
662 +                                                  write SetCaseSensitiveParameterNames;
663      property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
664      property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
665      property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
# Line 665 | Line 673 | type
673      property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
674      property Parser: TSelectSQLParser read GetParser;
675      property BaseSQLSelect: TStrings read FBaseSQLSelect;
676 +    property SQLFiltered: boolean read FSQLFiltered write SetSQLFiltered;
677 +    property SQLFilterParams: TStrings read FSQLFilterParams write SetSQLFilterParams;
678  
679      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
680                                                   write FBeforeDatabaseDisconnect;
# Line 716 | Line 726 | type
726      function IsSequenced: Boolean; override;
727      procedure Post; override;
728      function ParamByName(ParamName: String): ISQLParam;
729 +    function FindParam(ParamName: String): ISQLParam;
730      property ArrayFieldCount: integer read FArrayFieldCount;
731      property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
732      property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
# Line 773 | Line 784 | type
784                                                     write FOnDeleteReturning;
785    end;
786  
787 +  { TIBParserDataSet }
788 +
789    TIBParserDataSet = class(TIBCustomDataSet)
790 +  protected
791 +    procedure DoBeforeOpen; override;
792    public
793      property Parser;
794    end;
# Line 810 | Line 825 | type
825      property AutoCommit;
826      property BufferChunks;
827      property CachedUpdates;
828 +    property CaseSensitiveParameterNames;
829      property EnableStatistics;
830      property DeleteSQL;
831      property InsertSQL;
# Line 823 | Line 839 | type
839      property UniDirectional;
840      property Filtered;
841      property DataSetCloseAction;
842 +    property SQLFiltered;
843 +    property SQLFilterParams;
844  
845      property BeforeDatabaseDisconnect;
846      property AfterDatabaseDisconnect;
# Line 963 | Line 981 | const
981  
982   implementation
983  
984 < uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
984 > uses Variants, FmtBCD, LazUTF8, IBMessages, IBQuery;
985  
986   type
987  
# Line 1025 | Line 1043 | type
1043      Result := str;
1044    end;
1045  
1046 + { TIBParserDataSet }
1047 +
1048 + procedure TIBParserDataSet.DoBeforeOpen;
1049 + var i: integer;
1050 + begin
1051 +  if assigned(FParser) then
1052 +     FParser.RestoreClauseValues;
1053 +  if SQLFiltered then
1054 +    for i := 0 to SQLFilterParams.Count - 1 do
1055 +      Parser.Add2WhereClause(SQLFilterParams[i]);
1056 +  for i := 0 to FIBLinks.Count - 1 do
1057 +    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
1058 +  inherited DoBeforeOpen;
1059 +  for i := 0 to FIBLinks.Count - 1 do
1060 +    TIBControlLink(FIBLinks[i]).UpdateParams(self);
1061 + end;
1062 +
1063   { TIBLargeIntField }
1064  
1065   procedure TIBLargeIntField.Bind(Binding: Boolean);
# Line 1279 | Line 1314 | begin
1314      IBFieldDef := FieldDef as TIBFieldDef;
1315      CharacterSetSize := IBFieldDef.CharacterSetSize;
1316      CharacterSetName := IBFieldDef.CharacterSetName;
1317 <    FDataSize := IBFieldDef.DataSize + 1;
1317 >    FDataSize := IBFieldDef.DataSize;
1318      if AutoFieldSize then
1319        Size := IBFieldDef.Size;
1320      CodePage := IBFieldDef.CodePage;
# Line 1322 | Line 1357 | var
1357    s: RawByteString;
1358   begin
1359    Buffer := nil;
1360 <  IBAlloc(Buffer, 0, DataSize);
1360 >  IBAlloc(Buffer, 0, DataSize + 1); {allow for trailing #0}
1361    try
1362      Result := GetData(Buffer);
1363      if Result then
# Line 1331 | Line 1366 | begin
1366        SetCodePage(s,CodePage,false);
1367        if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1368          SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1369 <      Value := s;
1369 >
1370 >      if (CodePage = CP_UTF8) and (UTF8Length(s) > Size) then
1371 >        {truncate to max. number of UTF8 characters - usually a problem with
1372 >         fixed width columns right padded with white space}
1373 >        Value := UTF8Copy(s,1,Size)
1374 >      else
1375 >        Value := s;
1376 >
1377   //      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1378        if Transliterate and (Value <> '') then
1379          DataSet.Translate(PChar(Value), PChar(Value), False);
# Line 1347 | Line 1389 | var
1389    s: RawByteString;
1390   begin
1391    Buffer := nil;
1392 <  IBAlloc(Buffer, 0, DataSize);
1392 >  IBAlloc(Buffer, 0, DataSize + 1); {allow for trailing #0}
1393    try
1394      s := Value;
1395      if StringCodePage(s) <> CodePage then
1396        SetCodePage(s,CodePage,CodePage<>CP_NONE);
1397 <    StrLCopy(Buffer, PChar(s), DataSize-1);
1397 >    StrLCopy(Buffer, PChar(s), DataSize);
1398      if Transliterate then
1399        DataSet.Translate(Buffer, Buffer, True);
1400      SetData(Buffer);
# Line 1460 | Line 1502 | end;
1502  
1503   procedure TIBDataLink.ActiveChanged;
1504   begin
1505 <  if FDataSet.Active then
1505 >  if DetailDataSet.Active and DataSet.Active then
1506      FDataSet.RefreshParams;
1507   end;
1508  
# Line 1544 | Line 1586 | begin
1586      if AOwner is TIBTransaction then
1587        Transaction := TIBTransaction(AOwner);
1588    FBaseSQLSelect := TStringList.Create;
1589 +  FSQLFilterParams := TStringList.Create;
1590 +  TStringList(FSQLFilterParams).OnChange :=  HandleSQLFilterParamsChanged;
1591   end;
1592  
1593   destructor TIBCustomDataSet.Destroy;
# Line 1566 | Line 1610 | begin
1610    FMappedFieldPosition := nil;
1611    if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1612    if assigned(FParser) then FParser.Free;
1613 +  if assigned(FSQLFilterParams) then FSQLFilterParams.Free;
1614    inherited Destroy;
1615   end;
1616  
# Line 2988 | Line 3033 | procedure TIBCustomDataSet.SetUniDirecti
3033   begin
3034    CheckDatasetClosed;
3035    FUniDirectional := Value;
3036 +  inherited SetUniDirectional(Value);
3037   end;
3038  
3039   procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
# Line 3097 | Line 3143 | end;
3143  
3144   function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
3145   begin
3146 +  Result := FindParam(ParamName);
3147 +  if Result = nil then
3148 +    IBError(ibxeParameterNameNotFound,[ParamName]);
3149 + end;
3150 +
3151 + function TIBCustomDataSet.FindParam(ParamName: String): ISQLParam;
3152 + begin
3153    ActivateConnection;
3154    ActivateTransaction;
3155    if not FInternalPrepared then
# Line 3450 | Line 3503 | begin
3503      ApplyUpdates;
3504   end;
3505  
3453 – procedure TIBCustomDataSet.DoBeforeOpen;
3454 – var i: integer;
3455 – begin
3456 –  if assigned(FParser) then
3457 –     FParser.RestoreClauseValues;
3458 –  for i := 0 to FIBLinks.Count - 1 do
3459 –    TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3460 –  inherited DoBeforeOpen;
3461 –  for i := 0 to FIBLinks.Count - 1 do
3462 –    TIBControlLink(FIBLinks[i]).UpdateParams(self);
3463 – end;
3464 –
3506   procedure TIBCustomDataSet.DoBeforePost;
3507   begin
3508    inherited DoBeforePost;
# Line 3602 | Line 3643 | begin
3643          Data := Buff + fdDataOfs;
3644          if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3645          begin
3646 <          if fdDataLength < Field.DataSize then
3646 >          if fdDataLength <= Field.DataSize then
3647            begin
3648              Move(Data^, Buffer^, fdDataLength);
3649              PChar(Buffer)[fdDataLength] := #0;
# Line 3611 | Line 3652 | begin
3652              IBError(ibxeFieldSizeError,[Field.FieldName])
3653          end
3654          else
3655 <          Move(Data^, Buffer^, Field.DataSize);
3655 >        if fdDataLength <= Field.DataSize then
3656 >          Move(Data^, Buffer^, Field.DataSize)
3657 >        else
3658 >          IBError(ibxeFieldSizeError,[Field.FieldName,Field.DataSize,fdDataLength])
3659        end;
3660    end;
3661   end;
# Line 3782 | Line 3826 | var
3826    Buff: PChar;
3827    CurRec: Integer;
3828    pda: PArrayDataArray;
3829 +  pbd: PBlobDataArray;
3830    i: integer;
3831   begin
3832    inherited InternalCancel;
# Line 3789 | Line 3834 | begin
3834    if Buff <> nil then
3835    begin
3836      pda := PArrayDataArray(Buff + FArrayCacheOffset);
3837 +    pbd := PBlobDataArray(Buff + FBlobCacheOffset);
3838      for i := 0 to ArrayFieldCount - 1 do
3839        pda^[i].ArrayIntf.CancelChanges;
3840      CurRec := FCurrentRecord;
3841      AdjustRecordOnInsert(Buff);
3842      if (State = dsEdit) then begin
3843        CopyRecordBuffer(FOldBuffer, Buff);
3844 +      for i := 0 to BlobFieldCount - 1 do
3845 +        pbd^[i] := nil;
3846        WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3847      end else begin
3848        CopyRecordBuffer(FModelBuffer, Buff);
# Line 3874 | Line 3922 | end;
3922   procedure TIBCustomDataSet.InternalFirst;
3923   begin
3924    FCurrentRecord := -1;
3925 +  if Unidirectional then GetNextRecord;
3926   end;
3927  
3928   procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer);
# Line 3899 | Line 3948 | begin
3948   procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3949   const
3950    DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3951 <               'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
3951 >               'F.RDB$DEFAULT_VALUE, Trim(R.RDB$FIELD_NAME) as RDB$FIELD_NAME ' + {do not localize}
3952                 'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3953                 'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3954                 'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
# Line 3907 | Line 3956 | const
3956                 '     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3957  
3958    DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3959 <               'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3959 >               'F.RDB$DEFAULT_VALUE, Trim(R.RDB$FIELD_NAME) as RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3960                 'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3961                 'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3962                 'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
# Line 4606 | Line 4655 | begin
4655            fdIsNull := True
4656          else
4657          begin
4658 <          Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4658 >          if fdDataSize >= Field.DataSize then
4659 >            Move(Buffer^, Buff[fdDataOfs],fdDataSize)
4660 >          else
4661 >            IBError(ibxeDBBufferTooSmall,[fdDataSize,Field.FieldName,Field.DataSize]);
4662 >
4663            if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4664              fdDataLength := StrLen(PChar(Buffer));
4665            fdIsNull := False;
# Line 4750 | Line 4803 | begin
4803    Result := FQSelect.Statement;
4804   end;
4805  
4806 + procedure TIBCustomDataSet.SetCaseSensitiveParameterNames(AValue: boolean);
4807 + begin
4808 +  if FCaseSensitiveParameterNames = AValue then Exit;
4809 +  FCaseSensitiveParameterNames := AValue;
4810 +  if assigned(FQSelect) then
4811 +    FQSelect.CaseSensitiveParameterNames := AValue;
4812 + end;
4813 +
4814 + procedure TIBCustomDataSet.SetSQLFiltered(AValue: boolean);
4815 + begin
4816 +  if FSQLFiltered = AValue then Exit;
4817 +  FSQLFiltered := AValue;
4818 +  if Active then
4819 +  begin
4820 +    Active := false;
4821 +    Active := true;
4822 +  end;
4823 + end;
4824 +
4825 + procedure TIBCustomDataSet.SetSQLFilterParams(AValue: TStrings);
4826 + begin
4827 +  if FSQLFilterParams = AValue then Exit;
4828 +  FSQLFilterParams.Assign(AValue);
4829 + end;
4830 +
4831   procedure TIBCustomDataSet.SetMasterDetailDelay(AValue: integer);
4832   begin
4833    FDataLink.DelayTimerValue := AValue;
# Line 4762 | Line 4840 | begin
4840    Result := FParser
4841   end;
4842  
4843 + procedure TIBCustomDataSet.HandleSQLFilterParamsChanged(Sender: TObject);
4844 + begin
4845 +  Active := false;
4846 + end;
4847 +
4848   procedure TIBCustomDataSet.ResetParser;
4849   begin
4850    if assigned(FParser) then
# Line 5216 | Line 5299 | end;
5299  
5300   procedure TIBGenerator.SetQuerySQL;
5301   begin
5302 <  FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5302 >  if Database <> nil then
5303 >    FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',
5304 >      [QuoteIdentifierIfNeeded(Database.SQLDialect,FGeneratorName),Increment]);
5305   end;
5306  
5307   function TIBGenerator.GetDatabase: TIBDatabase;
# Line 5232 | Line 5317 | end;
5317   procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5318   begin
5319    FQuery.Database := AValue;
5320 +  SetQuerySQL;
5321   end;
5322  
5323   procedure TIBGenerator.SetGeneratorName(AValue: string);

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines