441 |
|
FRecordCount: Integer; |
442 |
|
FRecordSize: Integer; |
443 |
|
FDataSetCloseAction: TDataSetCloseAction; |
444 |
+ |
FSQLFiltered: boolean; |
445 |
+ |
FSQLFilterParams: TStrings; |
446 |
|
FUniDirectional: Boolean; |
447 |
|
FUpdateMode: TUpdateMode; |
448 |
|
FUpdateObject: TIBDataSetUpdateObject; |
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 |
|
|
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; |
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; |
788 |
|
|
789 |
|
TIBParserDataSet = class(TIBCustomDataSet) |
790 |
|
protected |
784 |
– |
procedure SetFilterText(const Value: string); override; |
791 |
|
procedure DoBeforeOpen; override; |
792 |
|
public |
793 |
|
property Parser; |
839 |
|
property UniDirectional; |
840 |
|
property Filtered; |
841 |
|
property DataSetCloseAction; |
842 |
+ |
property SQLFiltered; |
843 |
+ |
property SQLFilterParams; |
844 |
|
|
845 |
|
property BeforeDatabaseDisconnect; |
846 |
|
property AfterDatabaseDisconnect; |
981 |
|
|
982 |
|
implementation |
983 |
|
|
984 |
< |
uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery; |
984 |
> |
uses Variants, FmtBCD, LazUTF8, IBMessages, IBQuery; |
985 |
|
|
986 |
|
type |
987 |
|
|
1045 |
|
|
1046 |
|
{ TIBParserDataSet } |
1047 |
|
|
1040 |
– |
procedure TIBParserDataSet.SetFilterText(const Value: string); |
1041 |
– |
begin |
1042 |
– |
if Filter = Value then Exit; |
1043 |
– |
inherited SetFilterText(Value); |
1044 |
– |
if Active and Filtered then {reopen dataset} |
1045 |
– |
begin |
1046 |
– |
Active := false; |
1047 |
– |
Active := true; |
1048 |
– |
end; |
1049 |
– |
end; |
1050 |
– |
|
1048 |
|
procedure TIBParserDataSet.DoBeforeOpen; |
1049 |
|
var i: integer; |
1050 |
|
begin |
1051 |
|
if assigned(FParser) then |
1052 |
|
FParser.RestoreClauseValues; |
1053 |
< |
if Filtered and (Filter <> '') then |
1054 |
< |
Parser.Add2WhereClause(Filter); |
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; |
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; |
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 |
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); |
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); |
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 |
|
|
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; |
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 |
|
|
3033 |
|
begin |
3034 |
|
CheckDatasetClosed; |
3035 |
|
FUniDirectional := Value; |
3036 |
+ |
inherited SetUniDirectional(Value); |
3037 |
|
end; |
3038 |
|
|
3039 |
|
procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
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; |
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; |
3826 |
|
Buff: PChar; |
3827 |
|
CurRec: Integer; |
3828 |
|
pda: PArrayDataArray; |
3829 |
+ |
pbd: PBlobDataArray; |
3830 |
|
i: integer; |
3831 |
|
begin |
3832 |
|
inherited InternalCancel; |
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); |
3922 |
|
procedure TIBCustomDataSet.InternalFirst; |
3923 |
|
begin |
3924 |
|
FCurrentRecord := -1; |
3925 |
+ |
if Unidirectional then GetNextRecord; |
3926 |
|
end; |
3927 |
|
|
3928 |
|
procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer); |
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} |
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} |
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; |
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; |
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 |
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; |
5317 |
|
procedure TIBGenerator.SetDatabase(AValue: TIBDatabase); |
5318 |
|
begin |
5319 |
|
FQuery.Database := AValue; |
5320 |
+ |
SetQuerySQL; |
5321 |
|
end; |
5322 |
|
|
5323 |
|
procedure TIBGenerator.SetGeneratorName(AValue: string); |