diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas index 00db010854..d13e23e394 100644 --- a/packages/fcl-db/src/base/bufdataset.pas +++ b/packages/fcl-db/src/base/bufdataset.pas @@ -2266,25 +2266,26 @@ var r : Integer; begin for r:=0 to length(FUpdateBuffer)-1 do - if assigned(FUpdateBuffer[r].OldValuesBuffer) then + if assigned(FUpdateBuffer[r].OldValuesBuffer) then FreeMem(FUpdateBuffer[r].OldValuesBuffer); SetLength(FUpdateBuffer,0); if assigned(FUpdateBlobBuffers) then for r:=0 to length(FUpdateBlobBuffers)-1 do - if assigned(FUpdateBlobBuffers[r]) then - begin - if FUpdateBlobBuffers[r]^.OrgBufID >= 0 then + if assigned(FUpdateBlobBuffers[r]) then begin - FreeBlobBuffer(FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID]); - FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID] :=FUpdateBlobBuffers[r]; - end - else - begin - setlength(FBlobBuffers,length(FBlobBuffers)+1); - FUpdateBlobBuffers[r]^.OrgBufID := high(FBlobBuffers); - FBlobBuffers[high(FBlobBuffers)] := FUpdateBlobBuffers[r]; + // update blob buffer is already referenced from record buffer (see InternalPost) + if FUpdateBlobBuffers[r]^.OrgBufID >= 0 then + begin + FreeBlobBuffer(FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID]); + FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID] := FUpdateBlobBuffers[r]; + end + else + begin + setlength(FBlobBuffers,length(FBlobBuffers)+1); + FUpdateBlobBuffers[r]^.OrgBufID := high(FBlobBuffers); + FBlobBuffers[high(FBlobBuffers)] := FUpdateBlobBuffers[r]; + end; end; - end; SetLength(FUpdateBlobBuffers,0); end; @@ -2542,7 +2543,7 @@ begin setlength(FBlobBuffers,length(FBlobBuffers)+1); new(ABlobBuffer); fillbyte(ABlobBuffer^,sizeof(ABlobBuffer^),0); - ABlobBuffer^.OrgBufID := high(FUpdateBlobBuffers); + ABlobBuffer^.OrgBufID := high(FBlobBuffers); FBlobBuffers[high(FBlobBuffers)] := ABlobBuffer; result := ABlobBuffer; end; diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas index 0454a92b86..43d942a931 100644 --- a/packages/fcl-db/tests/testdbbasics.pas +++ b/packages/fcl-db/tests/testdbbasics.pas @@ -1574,7 +1574,7 @@ procedure TTestBufDatasetDBBasics.TestMergeChangeLog; var ds: TCustomBufDataset; i: integer; - s: string; + s, FN: string; begin ds := DBConnector.GetNDataset(5) as TCustomBufDataset; with ds do @@ -1604,6 +1604,27 @@ begin checkequals(fields[0].OldValue,23); checkequals(fields[1].OldValue,'hanged'); end; + + // Test handling of [Update]BlobBuffers in TBufDataset + ds := DBConnector.GetFieldDataset as TCustomBufDataset; + with ds do + begin + // Testing scenario: read some records, so blob data are added into FBlobBuffers, + // then update blob field, so element is added to FUpdateBlobBuffers, then read again some records + // so next elements are added to FBlobBuffers, then again update blob field + // DefaultBufferCount is 10 + PacketRecords:=1; + Open; + FN := 'F'+FieldTypeNames[ftBlob]; + First; Edit; FieldByName(FN).AsString:='b01'; Post; + RecNo:=11; Edit; FieldByName(FN).AsString:='b11'; Post; + Next ; Edit; FieldByName(FN).AsString:='b12'; Post; + Last; + MergeChangeLog; + First; CheckEquals('b01', FieldByName(FN).AsString); + RecNo:=11; CheckEquals('b11', FieldByName(FN).AsString); + Next; CheckEquals('b12', FieldByName(FN).AsString); + end; end; procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset);