zMemtable

[aehimself]

All I can see is that since this checkin most LCL builds failed with this exact error. As by Pascal syntax it is correct, and compiles fine with Delphi...
Maybe the version numbers will be relevant...?

It started to fail with FPC 3.0.4, Lazarus 1.8.4 / 2.0.0.

[aehimself]

I do not know the best /most efficient way to do it..... so I tried with my limited knowledge and skill. This is my codes after few days of trying. Now it works for Integer/date/float/string/memo/blob fields. Please guide me how to improve it. Thank you.

Other than a few safeguards missing and (in my opinion) unnecessarily increasing the size of the saved data, all looks fine.

- ReadBlob and WriteBlob is missing the Try...Finally block.
- At Required, you are saving Boolean as Integer. Boolean having the size of 1, LongInt having the size of 4, you are wasting FieldCount * 3 bytes there
- I also think it's unnecessary to put the data type in the data part of the stream. We have the field type from the recently created FieldDefs. With this, you are adding FieldCount * 4 bytes bloat.

[miab3]

Hi kjteng ,

For me it works on:
Lazarus 2.0.8-Win32,
Lazarus 2.0.12-Win64,
and Lazarus 2.2RC2(FPC 3.2.2)-Win64(Win11),
Delphi 2006,
but creates larger files that are not compatible with aehimself version for Delphi.

Michał

[miab3]

Hi aehimself, Jan,

Maybe to adopt the 'kjteng' version to anything ?!?

Michał

[kjteng]

double post - deleted

[kjteng]

Other than a few safeguards missing and (in my opinion) unnecessarily increasing the size of the saved data, all looks fine.

- ReadBlob and WriteBlob is missing the Try...Finally block.
- At Required, you are saving Boolean as Integer. Boolean having the size of 1, LongInt having the size of 4, you are wasting FieldCount * 3 bytes there
- I also think it's unnecessary to put the data type in the data part of the stream. We have the field type from the recently created FieldDefs. With this, you are adding FieldCount * 4 bytes bloat.

Many thanks to your valuable advice. I have changed the codes accordingly as follows:

Code: Select all

procedure TZAbstractMemTable.LoadFromStream(AStream: TStream);
var
  len, ftype, a, b, cc, kk: Integer;  tx: string;  req: Boolean;
  tb: TBytes;

  function ReadByte: Byte;
  begin
    AStream.Read(result, 1)
  end;

  function ReadInt: longint;
  begin
    AStream.Read(result, Sizeof(longint));
  end;

  function ReadStr: string;
  begin
    cc := ReadInt;
    SetLength(result, cc);
    AStream.Readbuffer(Pointer(result)^, cc);
  end;

  procedure ReadBlob;
  var ms: TMemoryStream;
  begin
    cc := ReadInt;
    if cc > 0 then
      begin
        ms := TMemoryStream.Create;
        try
          ms.CopyFrom(AStream, cc);
         (Fields[b] as TBlobField).LoadFromStream(ms);
        finally
          ms.Free;
        end;
      end;
  end;

  procedure ReadData;
  begin
    cc := ReadInt;
    SetLength(tb, cc);
    AStream.ReadBuffer(Pointer(tb)^, cc);
    Fields[b].SetData(Pointer(tb));
  end;

begin
    CheckInactive;
    //Close;

    FieldDefs.Clear;
    DisableControls;
    AStream.Position:= 0;
    kk := ReadInt; //fieldcount
    try
      for a := 1 To kk do
        begin
          //tx := AStream.ReadAnsiString;
          tx := ReadStr;
          ftype := ReadInt;
          len := ReadInt;
          req := ReadByte > 0;
          FieldDefs.Add(tx, TFieldType(fType), len, req);
        end;
      Open;  // Open - setup fields structure for memtable

      kk := ReadInt; // recordcount
      for a := 1 to kk do
        begin
          Append;
          for b := 0 to FieldCount - 1 do
            begin
              case Fields[b].DataType of
                ftString, ftMemo: Fields[b].AsString :=  ReadStr;
                ftBlob: try ReadBlob; except end;
                else  ReadData;
              end; //case
            end;
            Post;
        end;
      {try
        while true do
          begin
            Append;
            for b := 0 to FieldCount - 1 do
              begin
                cc := ReadInt;
                case cc of
                  -maxint..-1: ReadBlob;
                  0:           ; //No data - ignore
                  1..1000:     ReadData; //simple type
                  1001:        Fields[b].AsString :=  ReadStr;
                end; //case
              end;
            if AStream.Position < AStream.Size then
              Post
            else
              begin
                Cancel ;
                Break
              end;
          end;
      except
      end; }
      First;
    finally
      EnableControls;
    end;
 // end;
end;



procedure TZAbstractMemTable.SaveToStream(AStream: TStream);
var bm: TBookMark; a, cc: Integer;
    tb: TBytes;

  procedure WriteByte(bb: byte);
  begin
    AStream.Write(bb, 1);
  end;

  procedure WriteInt(ii: longint);
  begin
    AStream.Write(ii, Sizeof(longint))
  end;

  procedure WriteStr(tx: string);
  begin
    cc := Length(tx); WriteInt(cc);
    AStream.WriteBuffer(Pointer(tx)^, cc);
  end;

  procedure WriteBlob;
  var ms: TMemoryStream;
  begin
    ms:= TMemoryStream.Create;
    try
      (Fields[a] as TBlobField).SaveToStream(ms);
      cc := ms.Size;
      WriteInt(cc);
      if cc > 0 then
        begin
          ms.Position := 0;
          AStream.CopyFrom(ms, cc);
        end;
    finally    
      ms.Free;
    end;
  end;

  procedure WriteData;
  begin
    cc := Fields[a].DataSize;
    SetLength(tb, cc);
    Fields[a].GetData(Pointer(tb));
    WriteInt(cc);
    AStream.Writebuffer(Pointer(tb)^, cc);
  end;

begin
  CheckActive;
  bm := GetBookmark;
  AStream.Position:= 0;
  try
    DisableControls;

    try
      WriteInt(FieldDefs.Count);
      for a := 0 To FieldDefs.Count - 1 do
        begin
          WriteStr(FieldDefs[a].Name);
          WriteInt(ord(FieldDefs[a].DataType));
          WriteInt(FieldDefs[a].Size);
          WriteByte(Byte(FieldDefs[a].Required));
        end;
      First;
      WriteInt(RecordCount);
      while not Eof Do
        begin
          for a := 0 To FieldCount - 1 Do
            case Fields[a].DataType of
                ftString, ftMemo: WriteStr(Fields[a].AsString);
                ftBlob: WriteBlob;
                else WriteData
            end; //case
          Next;
        end;
    finally
      EnableControls;
    end;
  finally
    GotoBookmark(bm);
  end;

end;


procedure TZAbstractMemTable.LoadFromFile(Filename: TFilename);
var F1: TFileStream;
begin
  F1 := TFileStream.Create(Filename, fmOpenRead + fmShareCompat);
  try
    Self.LoadFromStream(F1);
  finally;
    F1.Free;
  end;
end;

procedure TZAbstractMemTable.SaveToFile(Filename: TFilename);
var F1: TFileStream;
begin
  F1 := TFileStream.Create(Filename, fmCreate);
  try
    Self.SaveToStream(F1);
  finally
    F1.Free;
  end;
end;

[aehimself]

For me it works on:
Lazarus 2.0.8-Win32,
Lazarus 2.0.12-Win64,
and Lazarus 2.2RC2(FPC 3.2.2)-Win64(Win11),
Delphi 2006

Michal,
Does this mean that mine does not compile / work under Lazarus / old Delphi?
I need this feedback to be able to fine-tune my concept.

Maybe to adopt the 'kjteng' version to anything ?!?

This version still uses TBytes (which should be TValueBuffer anyway), which does not exist on earlier Delphi versions. It also disregards the WITH_TVALUEBUFFER directive, meaning it has no "backup" if it does not exist in the environment.

[miab3]

Hi aehimself,

For Delphi2006:

Code: Select all

[Pascal Error] ZMemTable.pas(544): E2003 Undeclared identifier: 'ReadData'
[Pascal Error] ZMemTable.pas(674): E2003 Undeclared identifier: 'WriteData'
[Pascal Error] ZMemTable.pas(715): E2035 Not enough actual parameters -- AStream.CopyFrom(ms);
[Pascal Error] ZMemTable.pas(739): E2008 Incompatible types -- AStream.Write(buf, Length(buf));

Michał

[aehimself]

Michal,

Thank you very much! I fixed the errors in D2006 and also took some ideas from kjteng to simplify the code. Please test with this:

Code: Select all

{$IFDEF ZMEMTABLE_ENABLE_STREAM_EXPORT_IMPORT}
Procedure TZAbstractMemTable.LoadFromStream(AStream: TStream);

 Function ReadBool: Boolean;
 Begin
  AStream.Read(Result, SizeOf(Boolean));
 End;

 Function ReadInt: Integer;
 Begin
  AStream.Read(Result, SizeOf(Integer));
 End;

 Function ReadString: String;
 Begin
  SetLength(Result, ReadInt);
  AStream.Read(Pointer(Result)^, Length(Result) * SizeOf(Char));
 End;

Var
 a, b, len, ftype, fsize: Integer;
 fname: String;
 buf: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF};
 ms: TMemoryStream;
Begin
 Self.CheckInactive;

 Self.FieldDefs.Clear;

 Self.DisableControls;
 Try
   // Recreate FieldDefs
   len := ReadInt;
   For a := 0 To len - 1 Do
   Begin
     fname := ReadString;
     ftype := ReadInt;
     fsize := ReadInt;
     Self.FieldDefs.Add(fname, TFieldType(ftype), fsize, ReadBool);
   End;

   // Activate the MemTable so we can write the data back
   Self.Open;

   // Now read each field of each record, one by one
   len := ReadInt;
   For a := 0 To len - 1 Do
   Begin
     Self.Append;

     For b := 0 To Self.FieldCount - 1 Do
     Begin
       If Self.Fields[b] Is TBlobField Then
       Begin
         ms := TMemoryStream.Create;
         Try
           ms.CopyFrom(AStream, ReadInt);
           ms.Position := 0;
           (Self.Fields[b] As TBlobField).LoadFromStream(ms);
         Finally
           FreeAndNil(ms);
         End;
       End
       Else
       Begin
         {$IFDEF WITH_TVALUEBUFFER}
         SetLength(buf, ReadInt);
         AStream.Read(buf[0], Length(buf));
         Self.Fields[b].SetData(buf);
         {$ELSE}
         fsize := ReadInt;
         GetMem(buf, fsize);
         Try
           AStream.Read(buf^, fsize);
           Self.Fields[b].SetData(buf);
         Finally
           FreeMem(buf);
         End;
         {$ENDIF}
       End;
     End;

     Self.Post;
   End;

   Self.First;
 Finally
   Self.EnableControls;
 End;
End;
{$ENDIF}

{$IFDEF ZMEMTABLE_ENABLE_STREAM_EXPORT_IMPORT}
Procedure TZAbstractMemTable.SaveToStream(AStream: TStream);

 Procedure WriteBool(Const ABoolean: Boolean);
 Begin
  AStream.Write(ABoolean, SizeOf(Boolean));
 End;

 Procedure WriteInt(Const ANumber: Integer);
 Begin
  AStream.Write(ANumber, SizeOf(Integer));
 End;

 Procedure WriteString(Const AText: String);
 Begin
  WriteInt(Length(AText));
  AStream.Write(Pointer(AText)^, Length(AText) * SizeOf(Char));
 End;

Var
 bm: TBookMark;
 a: Integer;
 buf: {$IFDEF WITH_TVALUEBUFFER}TValueBuffer{$ELSE}Pointer{$ENDIF};
 ms: TMemoryStream;
Begin
 Self.CheckActive;

 bm := Self.GetBookmark;
 Try
   Self.DisableControls;
   Try
     // Write all FieldDefs
     WriteInt(Self.FieldDefs.Count);
     For a := 0 To Self.FieldDefs.Count - 1 Do
     Begin
       WriteString(Self.FieldDefs[a].Name);
       WriteInt(Integer(Self.FieldDefs[a].DataType));
       WriteInt(Self.FieldDefs[a].Size);
       WriteBool(Self.FieldDefs[a].Required);
     End;

     // Write the number of records the MemTable holds
     WriteInt(Self.RecordCount);

     // Write each field of each record, one by one
     Self.First;
     While Not Self.Eof Do
     Begin
       For a := 0 To Self.FieldCount - 1 Do
       Begin
         If Self.Fields[a] Is TBlobField Then
         Begin
           ms := TMemoryStream.Create;
           Try
             (Self.Fields[a] As TBlobField).SaveToStream(ms);
             ms.Position := 0;
             WriteInt(ms.Size);
             AStream.CopyFrom(ms, ms.Size);
           Finally
             FreeAndNil(ms);
           End;
         End
         Else
         Begin
           {$IFDEF WITH_TVALUEBUFFER}
           SetLength(buf, Self.Fields[a].DataSize);
           Self.Fields[a].GetData(buf);
//           If buf[High(buf)] = 0 Then
//             For b := High(buf) - 1 DownTo Low(buf) Do
//               If buf[b] <> 0 Then
//               Begin
//                 SetLength(buf, b + 1);
//                 Break;
//               End;
           WriteInt(Length(buf));
           AStream.Write(buf, Length(buf));
           {$ELSE}
           GetMem(buf, Self.Fields[a].DataSize);
           Try
             Self.Fields[a].GetData(buf);
             WriteInt(Self.Fields[a].DataSize);
             AStream.Write(buf^, Length(buf));
           Finally
             FreeMem(buf);
           End;
           {$ENDIF}
         End;
       End;

       Self.Next;
     End;
   Finally
     Self.EnableControls;
   End;
 Finally
   Self.GotoBookmark(bm);
 End;
End;
{$ENDIF}

I think I also found the reason why some FPC compilation failed. Once you confirm it works under D2006 I'll submit a pull request with the fix.
Please also confirm if the code works under Lazarus too!

[miab3]

Hi aehimself,

For both Delphi2006 and Delphi DX2:

[DCC Error] ZMemTable.pas(681): E2008 Incompatible types -- AStream.Write(buf^, Length(buf));

Michał

[aehimself]

Slowly getting there...

I'll try to find my Delphi 7 installation disk. Would help a lot to be able to check for myself.
Unfortunately I don't have anything inbetween 7 and 10.4 :)

[aehimself]

AStream.Write(buf^, Length(buf));

Please change that line to

Code: Select all

AStream.Write(buf^, Self.Fields[a].DataSize);

TStream.Wite to Pointer^ should work, so... :)

[miab3]

Hi aehimself,

It seems to compile in D2006 and DX2 but the SaveToFile file is 2 times larger and with LoadFromFile it gets 'Stream read error'.

Code: Select all

       If Self.Fields[b] Is TBlobField Then
       Begin
         ms := TMemoryStream.Create;
         Try
           ms.CopyFrom(AStream, ReadInt);   <<<<<<<<<<<<<=================       AFTER THIS LINE
           ms.Position := 0;
           (Self.Fields[b] As TBlobField).LoadFromStream(ms);
         Finally
           FreeAndNil(ms);
         End;
       End

b2.png

Michał

[marsupilami]

I'll try to find my Delphi 7 installation disk. Would help a lot to be able to check for myself.
Unfortunately I don't have anything inbetween 7 and 10.4

Hmm - the virtual machines that are used for Jenkins have some more Delphi Versions installed. If it helps, I could add an account there for you We even could check if it still works good enough with a solution like X2Go - so we could add better security to it. The systems could be moved to a seperate subnet. Another option might be to use a VPN solution and then RDP through the VPN. I also could make some Linux machines available that host Lazarus and some database systems (SQL Server 2019 for Linux, Oracle) this way.

Regarding the general idea of making TZMemTable storable and loadable: I do like the idea of being able to store a dataset and read it again. There already was a discussion to add that kind of feature to TZQuery and allow a workflow that looks something like this: Load Data (store everything in RAM) -> Disconnect -> Modify -> Store Data -> Close Program -> Open Program -> Connect -> Load Data -> Apply Changes to database.
Also - while a Zeos internal binary format is good I wonder if it would be any good to be able to save and store Datasets in the XML representation used by Delphis TClientDataset.

[kjteng]

....

Hi aehimself,
I got 'Access violation' error when trying to SaveToStream. I think the problem is due to the
statement (Self.Fields[a] As TBlobField).SaveToStream(ms) -- I got error when the field type is ftMemo.

BTW I am using Lazarus 2.3.0 trunk version (FPC v3.3.1)