* Rewrote blobfields for TBufDataset

git-svn-id: trunk@5385 -

fcl/db/bufdataset.inc

@@ -21,8 +21,8 @@ constructor TBufDataset.Create(AOwner : TComponent);
 begin
   Inherited Create(AOwner);
   SetLength(FUpdateBuffer,0);
-  SetLength(FNonPostedStreams,0);
-  SetLength(FPostedStreams,0);
+  SetLength(FBlobBuffers,0);
+  SetLength(FUpdateBlobBuffers,0);
   BookmarkSize := sizeof(TBufBookmark);
   FPacketRecords := 10;
 end;
@@ -509,8 +509,7 @@ end;
 
 procedure TBufDataset.ApplyUpdates(MaxErrors: Integer);
 
-var SaveBookmark : pchar;
-    r            : Integer;
+var r            : Integer;
     FailedCount  : integer;
     Response     : TResolverResponse;
     StoreRecBuf  : PBufRecLinkItem;
@@ -555,38 +554,71 @@ begin
       end;
   finally
     if failedcount = 0 then
+      begin
       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
+          begin
+          Freemem(FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID]^.Buffer);
+          Dispose(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;
+      SetLength(FUpdateBlobBuffers,0);
+      end;
+
     FCurrentRecBuf := StoreRecBuf;
     Resync([]);
   end;
 end;
 
+
+procedure TBufDataset.InternalCancel;
+
+Var i            : integer;
+
+begin
+  if assigned(FUpdateBlobBuffers) then for i:=0 to length(FUpdateBlobBuffers)-1 do
+   if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
+    begin
+    Reallocmem(FUpdateBlobBuffers[i]^.Buffer,0);
+    Dispose(FUpdateBlobBuffers[i]);
+    FUpdateBlobBuffers[i] := nil;
+    end;
+end;
+
 procedure TBufDataset.InternalPost;
 
 Var tmpRecBuffer : PBufRecLinkItem;
     CurrBuff     : PChar;
-    i ,sid       : integer;
+    i            : integer;
     blobbuf      : tbufblobfield;
+    NullMask     : pbyte;
 
 begin
-// First, if there are changed blob-field, make copies of their streams and
-// set the stream-id's in the activebuffer
-  if assigned(FNonPostedStreams) then for i:=0 to length(FNonPostedStreams)-1 do
+  if assigned(FUpdateBlobBuffers) then for i:=0 to length(FUpdateBlobBuffers)-1 do
+   if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
     begin
-    sid := length(FPostedStreams);
-    SetLength(FPostedStreams,sid+1);
+    blobbuf.BlobBuffer := FUpdateBlobBuffers[i];
+    CurrBuff := ActiveBuffer;
+    NullMask := pbyte(CurrBuff);
 
-    FPostedStreams[sid] := TMemoryStream.Create;
+    inc(CurrBuff,FFieldBufPositions[FUpdateBlobBuffers[i]^.FieldNo-1]);
+    Move(blobbuf, CurrBuff^, GetFieldSize(FieldDefs[FUpdateBlobBuffers[i]^.FieldNo-1]));
+    unSetFieldIsNull(NullMask,FUpdateBlobBuffers[i]^.FieldNo-1);
     
-    FPostedStreams[sid].loadfromstream(FNonPostedStreams[i].AStream);
-
-    fillbyte(blobbuf,sizeof(TBufBlobField),0);
-    blobbuf.BufBlobId := sid+1;
-
-    SetFieldData(FieldByNumber(FNonPostedStreams[i].Id),@blobbuf);
+    FUpdateBlobBuffers[i]^.FieldNo := -1;
     end;
-  setlength(FNonPostedStreams,0);
 
   if state = dsInsert then
     begin
@@ -755,10 +787,101 @@ begin
     end;
 end;
 
+function TbufDataset.GetNewBlobBuffer : PBlobBuffer;
+
+var ABlobBuffer : PBlobBuffer;
+
+begin
+  setlength(FBlobBuffers,length(FBlobBuffers)+1);
+  new(ABlobBuffer);
+  fillbyte(ABlobBuffer^,sizeof(ABlobBuffer^),0);
+  ABlobBuffer^.OrgBufID := high(FUpdateBlobBuffers);
+  FBlobBuffers[high(FBlobBuffers)] := ABlobBuffer;
+  result := ABlobBuffer;
+end;
+
+function TbufDataset.GetNewWriteBlobBuffer : PBlobBuffer;
+
+var ABlobBuffer : PBlobBuffer;
+
+begin
+  setlength(FUpdateBlobBuffers,length(FUpdateBlobBuffers)+1);
+  new(ABlobBuffer);
+  fillbyte(ABlobBuffer^,sizeof(ABlobBuffer^),0);
+  FUpdateBlobBuffers[high(FUpdateBlobBuffers)] := ABlobBuffer;
+  result := ABlobBuffer;
+end;
+
+function TBufBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
+
+begin
+  Case Origin of
+    soFromBeginning : FPosition:=Offset;
+    soFromEnd       : FPosition:=FBlobBuffer^.Size+Offset;
+    soFromCurrent   : FpoSition:=FPosition+Offset;
+  end;
+  Result:=FPosition;
+end;
+
+
+function TBufBlobStream.Read(var Buffer; Count: Longint): Longint;
+
+var ptr : pointer;
+
+begin
+  if FPosition + count > FBlobBuffer^.Size then
+    count := FBlobBuffer^.Size-FPosition;
+  ptr := FBlobBuffer^.Buffer+FPosition;
+  move(ptr^,buffer,count);
+  inc(FPosition,count);
+  result := count;
+end;
+
+function TBufBlobStream.Write(const Buffer; Count: Longint): Longint;
+
+var ptr : pointer;
+
+begin
+  ReAllocMem(FBlobBuffer^.Buffer,FPosition+Count);
+  ptr := FBlobBuffer^.Buffer+FPosition;
+  move(buffer,ptr^,count);
+  inc(FBlobBuffer^.Size,count);
+  inc(FPosition,count);
+  Result := count;
+end;
+
+constructor TBufBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
+
+var bufblob : TBufBlobField;
+
+begin
+  FDataset := Field.DataSet as TBufDataset;
+  if mode = bmread then
+    begin
+    if not field.getData(@bufblob) then
+      DatabaseError(SFieldIsNull);
+    if not assigned(bufblob.BlobBuffer) then with FDataSet do
+      begin
+      FBlobBuffer := GetNewBlobBuffer;
+      LoadBlobIntoStream(field,self);
+      end
+    else
+      FBlobBuffer := bufblob.BlobBuffer;
+    end
+  else if mode=bmWrite then with FDataSet as TBufDataset do
+    begin
+    FBlobBuffer := GetNewWriteBlobBuffer;
+    FBlobBuffer^.FieldNo := Field.FieldNo;
+    if (field.getData(@bufblob)) and assigned(bufblob.BlobBuffer) then
+      FBlobBuffer^.OrgBufID := bufblob.BlobBuffer^.OrgBufID
+    else
+      FBlobBuffer^.OrgBufID := -1;
+    end;
+end;
+
 function TBufDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
 
-var mStream : TmemoryStream;
-    bufblob : TBufBlobField;
+var bufblob : TBufBlobField;
 
 begin
   result := nil;
@@ -767,30 +890,20 @@ begin
     if not field.getData(@bufblob) then
       exit;
 
-    mStream := TMemoryStream.Create;
-    if bufblob.BufBlobId>0 then
-      mStream.LoadFromStream(FPostedStreams[bufblob.BufBlobId-1])
-    else
-      LoadBlobIntoStream(field,mStream);
-
-    result := mStream;
+    result := TBufBlobStream.Create(Field as tblobfield,bmread);
     end
   else if mode=bmWrite then
     begin
-
-    if not (state in [dsEdit, dsInsert, dsFilter]) then
+    if not (state in [dsEdit, dsInsert, dsFilter, dsCalcFields]) then
       begin
       DatabaseErrorFmt(SNotInEditState,[Name],self);
       exit;
       end;
 
-    setlength(FNonPostedStreams,length(FNonPostedStreams)+1);
-    with FNonPostedStreams[high(FNonPostedStreams)] do
-      begin
-      id := field.fieldno;
-      astream := TMemoryStream.Create;
-      result := AStream;
-      end;
+    result := TBufBlobStream.Create(Field as tblobfield,bmWrite);
+
+    if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
+      DataEvent(deFieldChange, Ptrint(Field));
     end;
 end;
 

fcl/db/db.pp

@@ -1498,6 +1498,28 @@ type
     property BeforeDisconnect : TNotifyEvent read FBeforeDisconnect write SetBeforeDisconnect;
   end;
 
+  { TBufBlobStream }
+  
+  PBlobBuffer = ^TBlobBuffer;
+  TBlobBuffer = record
+    FieldNo : integer;
+    OrgBufID: integer;
+    Buffer  : pointer;
+    Size    : ptrint;
+  end;
+
+   TBufBlobStream = class(TStream)
+  private
+    FBlobBuffer : PBlobBuffer;
+    FPosition   : ptrint;
+    FDataset    : TBufDataset;
+  protected
+    function Read(var Buffer; Count: Longint): Longint; override;
+    function Write(const Buffer; Count: Longint): Longint; override;
+    function Seek(Offset: Longint; Origin: Word): Longint; override;
+  public
+    constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
+  end;
 
   { TBufDataset }
 
@@ -1523,14 +1545,9 @@ type
   PBufBlobField = ^TBufBlobField;
   TBufBlobField = record
     ConnBlobBuffer : array[0..11] of byte; // It's here where the db-specific data is stored
-    BufBlobId      : Integer;
+    BlobBuffer     : PBlobBuffer;
   end;
   
-  TTempBlobStream = record
-    Id      : integer;
-    AStream : TMemoryStream;
-  end;
-
   TRecordsUpdateBuffer = array of TRecUpdateBuffer;
 
   TBufDataset = class(TDBDataSet)
@@ -1551,9 +1568,10 @@ type
     
     FAllPacketsFetched : boolean;
     FOnUpdateError  : TResolverErrorEvent;
-    
-    FNonPostedStreams : array of TTempBlobStream;
-    FPostedStreams    : array of TMemoryStream;
+
+    FBlobBuffers      : array of PBlobBuffer;
+    FUpdateBlobBuffers: array of PBlobBuffer;
+
     procedure CalcRecordSize;
     function LoadBuffer(Buffer : PChar): TGetResult;
     function GetFieldSize(FieldDef : TFieldDef) : longint;
@@ -1561,6 +1579,8 @@ type
     procedure SetPacketRecords(aValue : integer);
     function  IntAllocRecordBuffer: PChar;
   protected
+    function GetNewBlobBuffer : PBlobBuffer;
+    function GetNewWriteBlobBuffer : PBlobBuffer;
     procedure SetRecNo(Value: Longint); override;
     function  GetRecNo: Longint; override;
     function GetChangeCount: integer; virtual;
@@ -1574,6 +1594,7 @@ type
     function getnextpacket : integer;
     function GetRecordSize: Word; override;
     procedure InternalPost; override;
+    procedure InternalCancel; Override;
     procedure InternalDelete; override;
     procedure InternalFirst; override;
     procedure InternalLast; override;
@@ -1596,7 +1617,7 @@ type
   {abstracts, must be overidden by descendents}
     function Fetch : boolean; virtual; abstract;
     function LoadField(FieldDef : TFieldDef;buffer : pointer) : boolean; virtual; abstract;
-    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream); virtual; abstract;
+    procedure LoadBlobIntoStream(Field: TField;AStream: TStream); virtual; abstract;
   public
     constructor Create(AOwner: TComponent); override;
     procedure ApplyUpdates; virtual; overload;

fcl/db/dbconst.pp

@@ -79,6 +79,7 @@ Resourcestring
   SInvPacketRecordsValue   = 'PacketRecords has to be larger then 0';
   SInvalidSearchFieldType  = 'Searching in fields of type %s is not supported';
   SDatasetEmpty            = 'The dataset is empty';
+  SFieldIsNull             = 'The field is null';
   SOnUpdateError           = 'An error occured while applying the updates in a record: %s';
   SApplyRecNotSupported    = 'Applying updates is not supported by this TDataset descendent';
   SNoWhereFields           = 'There are no fields found to generate the where-clause';

fcl/db/sqldb/interbase/ibconnection.pp

@@ -84,7 +84,7 @@ type
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
-    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
+    procedure LoadBlobIntoStream(Field: TField;AStream: TStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
   public
     constructor Create(AOwner : TComponent); override;
     procedure CreateDB; override;
@@ -365,8 +365,6 @@ end;
 
 procedure TIBConnection.AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
 
-var x : shortint;
-
 begin
   FreeSQLDABuffer(aSQLDA);
 
@@ -496,9 +494,7 @@ procedure TIBConnection.PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLT
 
 var dh    : pointer;
     tr    : pointer;
-    p     : pchar;
     x     : shortint;
-    i     : integer;
 
 begin
   with cursor as TIBcursor do
@@ -1065,7 +1061,7 @@ begin
      CheckError('isc_blob_info', FStatus);
 end;
 
-procedure TIBConnection.LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction);
+procedure TIBConnection.LoadBlobIntoStream(Field: TField;AStream: TStream;cursor: TSQLCursor;ATransaction : TSQLTransaction);
 const
   isc_segstr_eof = 335544367; // It's not defined in ibase60 but in ibase40. Would it be better to define in ibase60?
 

fcl/db/sqldb/odbc/odbcconn.pas

@@ -90,7 +90,7 @@ type
     procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
     function Fetch(cursor:TSQLCursor):boolean; override;
     function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer):boolean; override;
-    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
+    procedure LoadBlobIntoStream(Field: TField;AStream: TStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
     procedure FreeFldBuffers(cursor:TSQLCursor); override;
     // - UpdateIndexDefs
     procedure UpdateIndexDefs(var IndexDefs:TIndexDefs; TableName:string); override;
@@ -642,7 +642,7 @@ begin
 //  writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
 end;
 
-procedure TODBCConnection.LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction);
+procedure TODBCConnection.LoadBlobIntoStream(Field: TField;AStream: TStream;cursor: TSQLCursor;ATransaction : TSQLTransaction);
 
 var
   ODBCCursor: TODBCCursor;
@@ -650,7 +650,7 @@ var
 begin
   Field.GetData(@BlobMemoryStream);
   if BlobMemoryStream<>nil then
-    AStream.LoadFromStream(BlobMemoryStream);
+//    AStream.LoadFromStream(BlobMemoryStream);
 end;
 
 procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);

fcl/db/sqldb/sqldb.pp

@@ -108,7 +108,7 @@ type
     procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
-    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); virtual;
+    procedure LoadBlobIntoStream(Field: TField;AStream: TStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); virtual;
   public
     property Handle: Pointer read GetHandle;
     destructor Destroy; override;
@@ -232,7 +232,7 @@ type
     procedure SetFilterText(const Value: string); override;
     Function GetDataSource : TDatasource; override;
     Procedure SetDataSource(AValue : TDatasource); 
-    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream); override;
+    procedure LoadBlobIntoStream(Field: TField;AStream: TStream); override;
   public
     procedure Prepare; virtual;
     procedure UnPrepare; virtual;
@@ -498,14 +498,14 @@ begin
   DatabaseError(SMetadataUnavailable);
 end;
 
-procedure TSQLConnection.LoadBlobIntoStream(Field: TField;AStream: TMemoryStream; cursor: TSQLCursor;ATransaction : TSQLTransaction);
+procedure TSQLConnection.LoadBlobIntoStream(Field: TField;AStream: TStream; cursor: TSQLCursor;ATransaction : TSQLTransaction);
 
 var blobId  : pinteger;
     BlobBuf : TBufBlobField;
     s       : string;
 
 begin
-  if not field.getData(@BlobBuf) then
+{  if not field.getData(@BlobBuf) then
     exit;
   blobId := @BlobBuf.BufBlobId;
 
@@ -513,7 +513,7 @@ begin
 
   AStream.WriteBuffer(s[1],length(s));
 
-  AStream.seek(0,soFromBeginning);
+  AStream.seek(0,soFromBeginning);}
 end;
 
 procedure TSQLConnection.CreateDB;
@@ -1295,7 +1295,7 @@ begin
   SQL.Add((DataBase as tsqlconnection).GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaPattern));
 end;
 
-procedure TSQLQuery.LoadBlobIntoStream(Field: TField;AStream: TMemoryStream);
+procedure TSQLQuery.LoadBlobIntoStream(Field: TField;AStream: TStream);
 
 begin
   (DataBase as tsqlconnection).LoadBlobIntoStream(Field, AStream, FCursor,(Transaction as tsqltransaction));