Browse Source

* fcl-db: bufdataset: free up cached blob buffers in unidirectional mode; alternate solution to issue #24509. Patch by Laco.

git-svn-id: trunk@27925 -
reiniero 11 years ago
parent
commit
e9f99fb3d2
1 changed files with 14 additions and 1 deletions
  1. 14 1
      packages/fcl-db/src/base/bufdataset.pas

+ 14 - 1
packages/fcl-db/src/base/bufdataset.pas

@@ -4021,8 +4021,21 @@ begin
 end;
 end;
 
 
 procedure TUniDirectionalBufIndex.AddRecord;
 procedure TUniDirectionalBufIndex.AddRecord;
+var
+  h,i: integer;
 begin
 begin
-  // Do nothing
+  // Release unneeded blob buffers, in order to save memory
+  // TDataSet has own buffer of records, so do not release blobs until they can be referenced
+  with FDataSet do
+    begin
+    h := high(FBlobBuffers) - BufferCount*BlobFieldCount;
+    if h > 10 then //Free in batches, starting with oldest (at beginning)
+      begin
+      for i := 0 to h do
+        FreeBlobBuffer(FBlobBuffers[i]);
+      FBlobBuffers := Copy(FBlobBuffers, h+1, high(FBlobBuffers)-h);
+      end;
+    end;
 end;
 end;
 
 
 procedure TUniDirectionalBufIndex.InsertRecordBeforeCurrentRecord(const ARecord:  TRecordBuffer);
 procedure TUniDirectionalBufIndex.InsertRecordBeforeCurrentRecord(const ARecord:  TRecordBuffer);