TZQuery does not generate a change of text blob field

[NickNevzorov]

TZQuery does not generate a change of text blob field by TWideMemo->TWideMemoField when new string length small or equal to old value

In TZVarVarLenDataRefStream need to override second Write method, becouse TWideMemoFiled used WriteBuffer to set data:

procedure TBlobField.SetData(Buffer: TValueBuffer; Len: Integer);
var
  LStream: TStream;
begin
  LStream := DataSet.CreateBlobStream(Self, bmWrite);
  try
    LStream.WriteBuffer(Buffer[0], Len);
  finally
    LStream.Free;
  end;
end;

And TStream.WriteBuffer used Write method with three parameters:

procedure TStream.WriteBuffer(Buffer: TBytes; Count: Longint);
var
  LTotalCount,
    LWrittenCount: Longint;
begin
  { Perform a write directly. Most of the time this will succeed
    without the need to go into the WHILE loop. }
  LTotalCount := Write(Buffer, 0, Count);

  while (LTotalCount < Count) do
  begin
    { Try to read a contiguous block of <Count> size }
    LWrittenCount := Write(Buffer, LTotalCount,(Count - LTotalCount));

    { Check if we written something and decrease the number of bytes left to read }
    if LWrittenCount <= 0 then
      raise EWriteError.CreateRes(@SReadError)
    else
      Inc(LTotalCount, LWrittenCount);
  end;
end;

And in TZVarVarLenDataRefStream.Write need to realloc FVarLenDataRef.VarLenData (without set new capacity AccesViolation raised)

function TZVarVarLenDataRefStream.Write(const Buffer; Count: Longint): Longint;
begin
  FUpdated := True;
  Capacity := Count; // Need to realloc FVarLenDataRef.VarLenData
  Result := inherited Write(Buffer, Count);
end;

[marsupilami79]

Hello Nick,

which driver do you use to trigger this bug? I think it might be a problem in the implementation of the driver. I am not sure, your changes are the right way to fix this. Could you maybe open a bugreport on Sourceforge and provide a sample application and a database create script that triggers the bug?

Best regards,

Jan

[NickNevzorov]

Ok. I will do it.

I am using Firebird - ODBC- TZConnection - TZQuery - TWideMemoFiled - TWideMemo for edit

[NickNevzorov]

Problem in different TMemoryStream implementation in different versions of Delphi.

In XE3 TMemoryStream has 2 "write" method (witch are needed to override):

  TMemoryStream = class(TCustomMemoryStream)
  private
    FCapacity: Longint;
    procedure SetCapacity(NewCapacity: Longint);
  protected
    function Realloc(var NewCapacity: Longint): Pointer; virtual;
    property Capacity: Longint read FCapacity write SetCapacity;
  public
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SetSize(NewSize: Longint); override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Write(const Buffer: TBytes; Offset, Count: Longint): Longint; override;
  end; // deprecated 'Use TBytesStream';

In Delphi 11 TMemoryStream has only one "write" method, witch already overridden by TZVarVarLenDataRefStream:

  TMemoryStream = class(TCustomMemoryStream)
  private
    FCapacity: NativeInt;
  protected
    procedure SetCapacity(NewCapacity: NativeInt); virtual;
    function Realloc(var NewCapacity: NativeInt): Pointer; virtual;
    property Capacity: NativeInt read FCapacity write SetCapacity;
  public
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SetSize(const NewSize: Int64); override;
    procedure SetSize(NewSize: Longint); override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

Now TZVarVarLenDataRefStream override only one method "write" and it incorrect works in Delphi XE3:

TZVarVarLenDataRefStream = class(TMemoryStream)
  private
    FVarLenDataRef: PZVarLenDataRef;
    FColumnCodePage: Word;
    FLobStreamMode: TZLobStreamMode;
    FUpdated: Boolean;
    FOwner: IZLob; //this keeps data alive while the stream is underway
    FOpenLobStreams: TZSortedList;
  protected
    function Realloc(var NewCapacity: {$IFDEF FPC}PtrInt{$ELSE}{$IFDEF MEMORYSTREAM_REALLOC_NATIVEINT}NativeInt{$ELSE}Longint{$ENDIF}{$ENDIF}): Pointer; override;
  public
    Constructor Create(const Owner: IZLob; CodePage: Word;
      VarLenDataRef: PZVarLenDataRef; LobStreamMode: TZLobStreamMode;
      const OpenLobStreams: TZSortedList);
    destructor Destroy; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

[NickNevzorov]

Open again. Bug actually in XE3 version of Delphi

[NickNevzorov]

My finally result. Override two methods:

function TZVarVarLenDataRefStream.Write(const Buffer; Count: Longint): Longint;
begin
  FUpdated := True;
  Result := inherited Write(Buffer, Count);
end;

// For Delphi XE3
function TZVarVarLenDataRefStream.Write(const Buffer: TBytes; Offset, Count: Integer): Longint;
begin
  FUpdated := True;
  Result := inherited Write(Buffer, Offset, Count);
end;

And clear dest stream before CopyFrom (because copyfrom only overwrites data, does not change capacity if dest stream bigger than src) in TZAbstractRWDataSet.PSUpdateRecord.CopyRecord:

            try
              DestStream := DestDataset.CreateBlobStream(DestField, bmWrite);
              try
                DestStream.Size := 0;
                DestStream.CopyFrom(SrcStream, 0);
              finally
                DestStream.Free;
              end;
            finally
              SrcStream.Free;
            end;