+ Basics for editing BLOB-fields

 + several cleanups

git-svn-id: trunk@4287 -

fcl/db/bufdataset.inc

@@ -21,6 +21,8 @@ constructor TBufDataset.Create(AOwner : TComponent);
 begin
   Inherited Create(AOwner);
   SetLength(FUpdateBuffer,0);
+  SetLength(FNonPostedStreams,0);
+  SetLength(FPostedStreams,0);
   BookmarkSize := sizeof(TBufBookmark);
   FPacketRecords := 10;
 end;
@@ -262,7 +264,8 @@ begin
     ftLargeInt   : result := sizeof(largeint);
     ftTime,
       ftDate,
-      ftDateTime : result := sizeof(TDateTime)
+      ftDateTime : result := sizeof(TDateTime);
+    ftBlob       : result := sizeof(TBufBlobField)
   else Result := 10
   end;
 
@@ -551,8 +554,28 @@ procedure TBufDataset.InternalPost;
 
 Var tmpRecBuffer : PBufRecLinkItem;
     CurrBuff     : PChar;
+    i ,sid       : integer;
+    blobbuf      : tbufblobfield;
 
 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
+    begin
+    sid := length(FPostedStreams);
+    SetLength(FPostedStreams,sid+1);
+
+    FPostedStreams[sid] := TMemoryStream.Create;
+    
+    FPostedStreams[sid].loadfromstream(FNonPostedStreams[i].AStream);
+
+    fillbyte(blobbuf,sizeof(TBufBlobField),0);
+    blobbuf.BufBlobId := sid+1;
+
+    SetFieldData(FieldByNumber(FNonPostedStreams[i].Id),@blobbuf);
+    end;
+  setlength(FNonPostedStreams,0);
+
   if state = dsInsert then
     begin
     if GetBookmarkFlag(ActiveBuffer) = bfEOF then
@@ -720,6 +743,45 @@ begin
     end;
 end;
 
+function TBufDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
+
+var mStream : TmemoryStream;
+    bufblob : TBufBlobField;
+
+begin
+  result := nil;
+  if mode=bmread then
+    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;
+    end
+  else if mode=bmWrite then
+    begin
+
+    if not (state in [dsEdit, dsInsert, dsFilter]) 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;
+    end;
+end;
+
 Function TBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; options: TLocateOptions) : boolean;
 
 

fcl/db/db.pp

@@ -730,6 +730,7 @@ type
     procedure AssignTo(Dest: TPersistent); override;
     procedure FreeBuffers; override;
     function GetAsString: string; override;
+    function GetAsVariant: Variant; override;
     function GetBlobSize: Longint; virtual;
     function GetIsNull: Boolean; override;
     procedure GetText(var TheText: string; ADisplayText: Boolean); override;
@@ -1518,6 +1519,17 @@ type
     BookmarkData       : pointer;
     OldValuesBuffer    : pchar;
   end;
+  
+  PBufBlobField = ^TBufBlobField;
+  TBufBlobField = record
+    ConnBlobBuffer : array[0..11] of byte; // It's here where the db-specific data is stored
+    BufBlobId      : Integer;
+  end;
+  
+  TTempBlobStream = record
+    Id      : integer;
+    AStream : TMemoryStream;
+  end;
 
   TRecordsUpdateBuffer = array of TRecUpdateBuffer;
 
@@ -1539,6 +1551,9 @@ type
     
     FAllPacketsFetched : boolean;
     FOnUpdateError  : TResolverErrorEvent;
+    
+    FNonPostedStreams : array of TTempBlobStream;
+    FPostedStreams    : array of TMemoryStream;
     procedure CalcRecordSize;
     function LoadBuffer(Buffer : PChar): TGetResult;
     function GetFieldSize(FieldDef : TFieldDef) : longint;
@@ -1581,6 +1596,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;
   public
     constructor Create(AOwner: TComponent); override;
     procedure ApplyUpdates; virtual; overload;
@@ -1589,6 +1605,7 @@ type
     destructor Destroy; override;
     function Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean; override;
     function UpdateStatus: TUpdateStatus; override;
+    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     property ChangeCount : Integer read GetChangeCount;
   published
     property PacketRecords : Integer read FPacketRecords write FPacketRecords default 10;

fcl/db/dbconst.pp

@@ -81,6 +81,7 @@ Resourcestring
   SDatasetEmpty            = 'The dataset is empty';
   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';
 
 Implementation
 

fcl/db/fields.inc

@@ -212,7 +212,7 @@ end;
 function TFieldDefs.GetItem(Index: Longint): TFieldDef;
 
 begin
-  Result := TFieldDef(inherited Items[Index]);;
+  Result := TFieldDef(inherited Items[Index]);
 end;
 
 function TFieldDefs.GetDataset: TDataset;
@@ -437,31 +437,31 @@ end;
 function TField.GetAsBoolean: Boolean;
 
 begin
-  AccessError(SBoolean);
+  raise AccessError(SBoolean);
 end;
 
 function TField.GetAsDateTime: TDateTime;
 
 begin
-  AccessError(SdateTime);
+  raise AccessError(SdateTime);
 end;
 
 function TField.GetAsFloat: Double;
 
 begin
-  AccessError(SDateTime);
+  raise AccessError(SDateTime);
 end;
 
 function TField.GetAsLongint: Longint;
 
 begin
-  AccessError(SInteger);
+  raise AccessError(SInteger);
 end;
 
 function TField.GetAsVariant: Variant;
 
 begin
-  AccessError(SVariant);
+  raise AccessError(SVariant);
 end;
 
 
@@ -2228,6 +2228,19 @@ begin
     Result := '(blob)';
 end;
 
+function TBlobField.GetAsVariant: Variant;
+
+Var s : string;
+
+begin
+  if not GetIsNull then
+    begin
+    s := GetAsString;
+    result := s;
+    end
+  else result := Null;
+end;
+
 
 function TBlobField.GetBlobSize: Longint;
 var

fcl/db/sqldb/interbase/ibconnection.pp

@@ -81,7 +81,7 @@ type
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
-    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
+    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
   public
     constructor Create(AOwner : TComponent); override;
     property BlobSegmentSize : word read FBlobSegmentSize write FBlobSegmentSize;
@@ -631,13 +631,10 @@ begin
         ftInteger :
           begin
           i := AParams[ParNr].AsInteger;
-          {$R-}
           Move(i, in_sqlda^.SQLvar[SQLVarNr].SQLData^, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
-          {$R+}
           end;
         ftString,ftFixedChar  :
           begin
-          {$R-}
           s := AParams[ParNr].AsString;
           w := length(s); // a word is enough, since the max-length of a string in interbase is 32k
           if ((in_sqlda^.SQLvar[SQLVarNr].SQLType and not 1) = SQL_VARYING) then
@@ -652,23 +649,16 @@ begin
             CurrBuff := in_sqlda^.SQLvar[SQLVarNr].SQLData;
 
           Move(s[1], CurrBuff^, w);
-          {$R+}
           end;
         ftDate, ftTime, ftDateTime:
-          {$R-}
           SetDateTime(in_sqlda^.SQLvar[SQLVarNr].SQLData, AParams[ParNr].AsDateTime, in_SQLDA^.SQLVar[SQLVarNr].SQLType);
-          {$R+}
         ftLargeInt:
           begin
           li := AParams[ParNr].AsLargeInt;
-          {$R-}
           Move(li, in_sqlda^.SQLvar[SQLVarNr].SQLData^, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
-          {$R+}
           end;
         ftFloat:
-          {$R-}
           SetFloat(in_sqlda^.SQLvar[SQLVarNr].SQLData, AParams[ParNr].AsFloat, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
-          {$R+}
         ftBlob:
           begin
           TransactionHandle := transaction.Handle;
@@ -693,7 +683,6 @@ begin
             
           if isc_close_blob(@FStatus, @blobHandle) <> 0 then
             CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
-
           Move(blobId, in_sqlda^.SQLvar[SQLVarNr].SQLData^, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
           end;
       else
@@ -769,7 +758,7 @@ begin
         ftFloat   :
           GetFloat(CurrBuff, Buffer, FieldDef);
         ftBlob : begin  // load the BlobIb in field's buffer
-            FillByte(buffer^,sizeof(LargeInt),0);
+            FillByte(buffer^,sizeof(TBufBlobField),0);
             Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
          end
 
@@ -1019,12 +1008,11 @@ begin
      CheckError('isc_blob_info', FStatus);
 end;
 
-function TIBConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
+procedure TIBConnection.LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;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?
 
 var
-  mStream : TMemoryStream;
   blobHandle : Isc_blob_Handle;
   blobSegment : pointer;
   blobSegLen : smallint;
@@ -1032,44 +1020,34 @@ var
   TransactionHandle : pointer;
   blobId : ISC_QUAD;
 begin
+  if not field.getData(@blobId) then
+    exit;
 
-  result := nil;
-  if mode = bmRead then begin
-
-    if not field.getData(@blobId) then
-      exit;
-
-    if not assigned(Transaction) then
-      DatabaseError(SErrConnTransactionnSet);
+  TransactionHandle := Atransaction.Handle;
+  blobHandle := nil;
 
-    TransactionHandle := transaction.Handle;
-    blobHandle := nil;
+  if isc_open_blob(@FStatus, @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, @blobId) <> 0 then
+    CheckError('TIBConnection.CreateBlobStream', FStatus);
 
-    if isc_open_blob(@FStatus, @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, @blobId) <> 0 then
-      CheckError('TIBConnection.CreateBlobStream', FStatus);
+  maxBlobSize := getMaxBlobSize(blobHandle);
 
-    maxBlobSize := getMaxBlobSize(blobHandle);
+  blobSegment := AllocMem(maxBlobSize);
 
-    blobSegment := AllocMem(maxBlobSize);
-    mStream := TMemoryStream.create;
-
-    while (isc_get_segment(@FStatus, @blobHandle, @blobSegLen, maxBlobSize, blobSegment) = 0) do begin
-        mStream.writeBuffer(blobSegment^, blobSegLen);
-    end;
-    freemem(blobSegment);
-    mStream.seek(0,soFromBeginning);
+  while (isc_get_segment(@FStatus, @blobHandle, @blobSegLen, maxBlobSize, blobSegment) = 0) do begin
+      AStream.writeBuffer(blobSegment^, blobSegLen);
+  end;
+  freemem(blobSegment);
+  AStream.seek(0,soFromBeginning);
 
-    if FStatus[1] = isc_segstr_eof then
-      begin
-        if isc_close_blob(@FStatus, @blobHandle) <> 0 then
-          CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
-      end
-    else
-      CheckError('TIBConnection.CreateBlobStream isc_get_segment', FStatus);
+  if FStatus[1] = isc_segstr_eof then
+    begin
+      if isc_close_blob(@FStatus, @blobHandle) <> 0 then
+        CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
+    end
+  else
+    CheckError('TIBConnection.CreateBlobStream isc_get_segment', FStatus);
+end;
 
-    result := mStream;
 
-  end;
-end;
 
 end.

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;
-    function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
+    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
     procedure FreeFldBuffers(cursor:TSQLCursor); override;
     // - UpdateIndexDefs
     procedure UpdateIndexDefs(var IndexDefs:TIndexDefs; TableName:string); override;
@@ -642,21 +642,15 @@ begin
 //  writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
 end;
 
-function TODBCConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
+procedure TODBCConnection.LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction);
+
 var
   ODBCCursor: TODBCCursor;
-  BlobMemoryStream, BlobMemoryStreamCopy: TMemoryStream;
+  BlobMemoryStream: TMemoryStream;
 begin
-  if (Mode=bmRead) and not Field.IsNull then
-  begin
-    Field.GetData(@BlobMemoryStream);
-    BlobMemoryStreamCopy:=TMemoryStream.Create;
-    if BlobMemoryStream<>nil then
-      BlobMemoryStreamCopy.LoadFromStream(BlobMemoryStream);
-    Result:=BlobMemoryStreamCopy;
-  end
-  else
-    Result:=nil;
+  Field.GetData(@BlobMemoryStream);
+  if BlobMemoryStream<>nil then
+    AStream.LoadFromStream(BlobMemoryStream);
 end;
 
 procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);

fcl/db/sqldb/oracle/oracleconnection.pp

@@ -66,7 +66,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;
-    function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
+//    function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
     procedure FreeFldBuffers(cursor:TSQLCursor); override;
 
   public
@@ -469,10 +469,10 @@ begin
     end;
 end;
 
-function TOracleConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
+{function TOracleConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
 begin
 //  Result:=inherited CreateBlobStream(Field, Mode);
-end;
+end;}
 
 procedure TOracleConnection.FreeFldBuffers(cursor: TSQLCursor);
 begin

fcl/db/sqldb/postgres/pqconnection.pp

@@ -472,6 +472,7 @@ begin
           begin
           case AParams[i].DataType of
             ftdatetime : s := formatdatetime('YYYY-MM-DD',AParams[i].AsDateTime);
+            ftdate     : s := formatdatetime('YYYY-MM-DD',AParams[i].AsDateTime);
           else
             s := AParams[i].asstring;
           end; {case}

fcl/db/sqldb/sqldb.pp

@@ -100,7 +100,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;
-    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
+    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); virtual;
   public
     property Handle: Pointer read GetHandle;
     destructor Destroy; override;
@@ -220,8 +220,9 @@ type
     Procedure SetActive (Value : Boolean); override;
     procedure SetFiltered(Value: Boolean); override;
     procedure SetFilterText(const Value: string); override;
-    Function GetDataSource : TDatasource;
+    Function GetDataSource : TDatasource; override;
     Procedure SetDataSource(AValue : TDatasource); 
+    procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream); override;
   public
     procedure Prepare; virtual;
     procedure UnPrepare; virtual;
@@ -229,7 +230,6 @@ type
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
     procedure SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string); virtual;
-    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     property Prepared : boolean read IsPrepared;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
   published
@@ -461,7 +461,7 @@ begin
   DatabaseError(SMetadataUnavailable);
 end;
 
-function TSQLConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
+procedure TSQLConnection.LoadBlobIntoStream(Field: TField;AStream: TMemoryStream; cursor: TSQLCursor;ATransaction : TSQLTransaction);
 
 begin
   DatabaseErrorFmt(SUnsupportedFieldType,['Blob']);
@@ -566,8 +566,6 @@ end;
 { TSQLQuery }
 procedure TSQLQuery.OnChangeSQL(Sender : TObject);
 
-var ParamName : String;
-
 begin
   UnPrepare;
   if (FSQL <> nil) then
@@ -1063,9 +1061,6 @@ end;
 
 Procedure TSQLQuery.ApplyRecUpdate(UpdateKind : TUpdateKind);
 
-var
-    s : string;
-
   procedure UpdateWherePart(var sql_where : string;x : integer);
 
   begin
@@ -1093,6 +1088,7 @@ var
       end;
 
     setlength(sql_set,length(sql_set)-1);
+    if length(sql_where) = 0 then DatabaseError(sNoWhereFields,self);
     setlength(sql_where,length(sql_where)-5);
     result := 'update ' + FTableName + ' set ' + sql_set + ' where ' + sql_where;
 
@@ -1131,6 +1127,7 @@ var
     for x := 0 to Fields.Count -1 do
       UpdateWherePart(sql_where,x);
 
+    if length(sql_where) = 0 then DatabaseError(sNoWhereFields,self);
     setlength(sql_where,length(sql_where)-5);
 
     result := 'delete from ' + FTableName + ' where ' + sql_where;
@@ -1207,9 +1204,10 @@ begin
   SQL.Add((DataBase as tsqlconnection).GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaPattern));
 end;
 
-function TSQLQuery.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
+procedure TSQLQuery.LoadBlobIntoStream(Field: TField;AStream: TMemoryStream);
+
 begin
-  result := (DataBase as tsqlconnection).CreateBlobStream(Field, Mode);
+  (DataBase as tsqlconnection).LoadBlobIntoStream(Field, AStream, FCursor,(Transaction as tsqltransaction));
 end;
 
 function TSQLQuery.GetStatementType : TStatementType;