Recent

Author Topic: save open records to disk  (Read 23253 times)

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: save open records to disk
« Reply #15 on: March 26, 2014, 09:55:03 pm »
taazz,
Thanks a lot! Now it works as I needed - perfect at this point.

Now I have to work out how to save two different records the same way and hopefully in one Dialog step. Any suggestions/references are more than welcome.

--------------------------------------------------
007,
Thanks for the link to the wiki page, I'm looking at it, and also to taazz for pointingout that it's for RTTI and it doesn't work for records.
-cl


It works for records inside components.

I think it will help you, if you want to change the way you program, instead of records using classes..

I've added a wiki article:
http://wiki.lazarus.freepascal.org/TCollection#Streaming

clemmi

  • Jr. Member
  • **
  • Posts: 54
Re: save open records to disk
« Reply #16 on: March 29, 2014, 11:01:31 pm »
I didn't see the last post until now, because it went to a new page, but I printed the wiki link and I'll digest it. - Thanks!

After successfully saving a record to stream and back (with a lot of good help), I'm trying to save two records because that's what I'll need for my program. so I made the modified testing program below:

I get these error messages which I'm not sure what they mean:
--------------------------------------
savecrspplrecords.pas(119,34) Error: Operator is not overloaded: "TCrsRecord" * "LongInt"
savecrspplrecords.pas(120,34) Error: Operator is not overloaded: "TPplRecord" * "LongInt"
savecrspplrecords.pas(123,55) Error: Operator is not overloaded: "TCrsRecord" + "TPplRecord"
savecrspplrecords.pas(134) Fatal: There were 3 errors compiling module, stopping
--------------------------------------

Code: [Select]
unit saveCrsPplrecords;
{$mode objfpc}{$H+}

interface
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, math;

type
  { TForm1 }
  TCrsRecord = record
                         code : string[3];
                         title: string[50];
                       end;

  TPplRecord = record
                         name: string[20];
                         choice: string[3];
                      end;

  TCrsRecordArray = array of TCrsRecord;
  TPplRecordArray = array of TPplRecord;

  TForm1 = class(TForm)
  SaveSTREAM: TButton;
  GetSTREAM: TButton;
  ListBox1: TListBox;
  ListBox2: TListBox;
  OpenDialog1: TOpenDialog;
  SaveDialog1: TSaveDialog;

  procedure FormCreate(Sender: TObject);
  procedure showrecords;

  procedure SaveSTREAMClick(Sender: TObject);
  procedure SaveAll(const aFileName: string;
                  const arCrsRecords: array of TCrsRecord;
                  const arPplRecords: array of TPplRecord);

  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  arCrsRecords : array[0..2] of TCrsRecord;
  arPplRecords : array[0..2] of TPplRecord;
  i : integer;

implementation
{$R *.lfm}
{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
  begin
    arCrsRecords[0].code := 'ORD';
    arCrsRecords[0].title := 'Order in Chaos';
    arCrsRecords[1].code := 'FBI';
    arCrsRecords[1].title := 'History of the FBI';
    arCrsRecords[2].code := 'RAN';
    arCrsRecords[2].title := 'Randomnes in life';

    arPplRecords[0].name := 'Moe';
    arPplRecords[0].choice := 'FBI';
    arPplRecords[1].name := 'Larry';
    arPplRecords[1].choice := 'ORD';
    arPplRecords[2].name := 'Curly';
    arPplRecords[2].choice := 'ORD';

    showrecords();
end;

procedure TForm1.showrecords;
begin
      listbox1.items[0] := 'arCrsRecord';
      listBox1.items[1] := '  ';
      ListBox1.items[2] := arCrsRecords[0].code + ' -- ' + arCrsRecords[0].title;
      ListBox1.Items[3] := arCrsRecords[1].code + ' -- ' + arCrsRecords[1].title;;
      ListBox1.Items[4] := arCrsRecords[2].code + ' -- ' + arCrsRecords[2].title;;

      listbox2.items[0] := 'arPplRecord';
      listBox2.items[1] := '  ';
      ListBox2.items[2] := arPplRecords[0].name + ' -- ' + arPplRecords[0].choice;
      ListBox2.Items[3] := arPplRecords[1].name + ' -- ' + arPplRecords[1].choice;
      ListBox2.Items[4] := arpplRecords[2].name + ' -- ' + arPplRecords[2].choice;
end;

procedure TForm1.SaveSTREAMClick(Sender: TObject);
begin
   if SaveDialog1.Execute then
      Form1.SaveAll(SaveDialog1.FileName, arCrsRecords, arPplRecords);
end;

procedure TForm1.SaveAll(const aFileName : string;
  const arCrsRecords: array of TCrsRecord;
  const arPplRecords: array of TPplRecord);
var
  vFileS : TFileStream = nil;
  vTotal : cardinal =0;
begin
  vfileS := TFileStream.Create(aFileName, fmOpenReadWrite or fmShareExclusive);
  try
    vTotal := SizeOf((TCrsRecord)*(High(arCrsRecords)-Low(arCrsRecords))) +
                             (TPplRecord)*(High(arPplRecords)-Low(arPplRecords));
    vFileS.Size := vTotal;
    vFileS.Seek(0,0);
    vFileS.Write( ( (arCrsRecords[Low(arCrsRecords)]) +
                          (arpplRecords[Low(arPplRecords)]) ) , vTotal);
  finally
    vfileS.Free;
  end;
end;

end.

I'm not sure if this way of saving two records is possible or not. I found no documentation about handling more than one records.

I'm working on the saving part only at this time.

The ListBoxes are ok at this time, it's just to eventually look at the save/load of the records.

-cl

clemmi

  • Jr. Member
  • **
  • Posts: 54
Re: save open records to disk
« Reply #17 on: March 30, 2014, 06:56:40 pm »
I was able to compile the program after some modifications,, but now when I click on the "SaveSTREAM" buttom, it opens the dialog, I enter a name for the file to save and after I click OK it gives me the message: "Unable to open file" and the save fails.

Code: [Select]
unit saveCrsPplrecords;
{$mode objfpc}{$H+}

interface
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
  Dialogs, StdCtrls, math;

type
  { TForm1 }
  TCrsRecord = record
                         code : string[3];
                         title: string[50];
                       end;

  TPplRecord = record
                         name: string[20];
                         choice: string[3];
                      end;

  TCrsRecordArray = array of TCrsRecord;
  TPplRecordArray = array of TPplRecord;

  TForm1 = class(TForm)

  SaveSTREAM: TButton;
  GetSTREAM: TButton;
  ListBox1: TListBox;
  ListBox2: TListBox;
  OpenDialog1: TOpenDialog;
  SaveDialog1: TSaveDialog;

  procedure FormCreate(Sender: TObject);
  procedure showrecords;

  procedure SaveSTREAMClick(Sender: TObject);
  procedure SaveAll(const aFileName: string;
                  const arCrsRecords: array of TCrsRecord;
                  const arPplRecords: array of TPplRecord);

  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

  arCrsRecords : array[0..2] of TCrsRecord;
  arPplRecords : array[0..2] of TPplRecord;
  i : integer;

implementation
{$R *.lfm}
{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
    arCrsRecords[0].code := 'ORD';
    arCrsRecords[0].title := 'Order in Chaos';
    arCrsRecords[1].code := 'FBI';
    arCrsRecords[1].title := 'History of the FBI';
    arCrsRecords[2].code := 'RAN';
    arCrsRecords[2].title := 'Randomnes in life';

    arPplRecords[0].name := 'Moe';
    arPplRecords[0].choice := 'FBI';
    arPplRecords[1].name := 'Larry';
    arPplRecords[1].choice := 'ORD';
    arPplRecords[2].name := 'Curly';
    arPplRecords[2].choice := 'ORD';

    showrecords();

end;

procedure TForm1.showrecords;
begin
      listbox1.items[0] := 'arCrsRecord';
      listBox1.items[1] := '  ';
      ListBox1.items[2] := arCrsRecords[0].code + ' -- ' + arCrsRecords[0].title;
      ListBox1.Items[3] := arCrsRecords[1].code + ' -- ' + arCrsRecords[1].title;;
      ListBox1.Items[4] := arCrsRecords[2].code + ' -- ' + arCrsRecords[2].title;;

      listbox2.items[0] := 'arPplRecord';
      listBox2.items[1] := '  ';
      ListBox2.items[2] := arPplRecords[0].name + ' -- ' + arPplRecords[0].choice;
      ListBox2.Items[3] := arPplRecords[1].name + ' -- ' + arPplRecords[1].choice;
      ListBox2.Items[4] := arpplRecords[2].name + ' -- ' + arPplRecords[2].choice;

end;

procedure TForm1.SaveSTREAMClick(Sender: TObject);
begin
  if Form1.SaveDialog1.Execute then
     Form1.SaveAll(SaveDialog1.FileName, arCrsRecords, arPplRecords);
     Form1.SaveDialog1.Close;
end;

procedure TForm1.SaveAll(const aFileName : string;
  const arCrsRecords: array of TCrsRecord;
  const arPplRecords: array of TPplRecord);
var
  vFileS : TFileStream = nil;
  vTotal : cardinal =0;
begin
  vfileS := TFileStream.Create(aFileName, fmOpenReadWrite or fmShareExclusive);
  try

//    vTotal := SizeOf((TCrsRecord)*(High(arCrsRecords)-Low(arCrsRecords))) +
//                     (TPplRecord)*(High(arPplRecords)-Low(arPplRecords));

    vTotal := SizeOf(TCrsRecord)* (High(arCrsRecords)-Low(arCrsRecords)) +
              SizeOf(TPplRecord)* (High(arPplRecords)-Low(arPplRecords));

    vFileS.Size := vTotal;
    vFileS.Seek(0,0);

//    vFileS.Write( ( (arCrsRecords[Low(arCrsRecords)]) +
//                    (arpplRecords[Low(arPplRecords)]) ) , vTotal);

    vFileS.Write(((arCrsRecords[Low(arCrsRecords)])), vTotal);

    vFileS.Seek(0, soFromEnd);
    vFileS.Write((arpplRecords[Low(arPplRecords)]), vTotal);
  finally
    vfileS.Free;
  end;
end;
end.


howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: save open records to disk
« Reply #18 on: March 30, 2014, 08:37:51 pm »
If you save to a newly created file you need the fmCreate flag in the TFileStream constructor. There are several other glitches in your code, including muddling static and dynamic array declarations. It is slightly simpler to consistently use static arrays in this case. The following indicates the way to go.

Code: [Select]
unit mainSavingRecords;

{$mode objfpc}{$H+}

interface

uses
  Classes, StdCtrls, SysUtils, Forms, Dialogs;

type

  TCrsRecord = record
                 code : string[3];
                 title: string[50];
               end;

  TPplRecord = record
                 name: string[20];
                 choice: string[3];
               end;

  TCrsRecordArray = array[0..2] of TCrsRecord;
  TPplRecordArray = array[0..2] of TPplRecord;

  { TForm1 }

  TForm1 = class(TForm)
    BGetStream: TButton;
    BSaveStream: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure BGetStreamClick(Sender: TObject);
    procedure BSaveStreamClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FcrsArray: TCrsRecordArray;
    FpplArray: TPplRecordArray;
    procedure ShowRecords;
    procedure SaveAll(const aFilename: string;
                      const arCrsRecords: TCrsRecordArray;
                      const arPplRecords: TPplRecordArray);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.BGetStreamClick(Sender: TObject);
var
  fs: TFileStream;
  i: integer;
begin
  ListBox1.Clear;
  ListBox2.Clear;
  FillChar(FcrsArray, SizeOf(TCrsRecordArray), 0);
  FillChar(FpplArray, SizeOf(TPplRecordArray), 0);

  if OpenDialog1.Execute then
  begin
    fs:=TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareExclusive);
    try
      for i:= Low(TCrsRecordArray) to High(TCrsRecordArray) do
        fs.Read(FcrsArray[i],SizeOf(TCrsRecord));
      for i:= Low(TPplRecordArray) to High(TPplRecordArray) do
        fs.Read(FpplArray[i], SizeOf(TPplRecord));
    finally
      fs.Free;
    end;
    ShowRecords;
  end;
end;

procedure TForm1.BSaveStreamClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
   SaveAll(SaveDialog1.FileName, FcrsArray, FpplArray);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FcrsArray[0].code := 'ORD';
  FcrsArray[0].title := 'Order in Chaos';
  FcrsArray[1].code := 'FBI';
  FcrsArray[1].title := 'History of the FBI';
  FcrsArray[2].code := 'RAN';
  FcrsArray[2].title := 'Randomnes in life';

  FpplArray[0].name := 'Moe';
  FpplArray[0].choice := 'FBI';
  FpplArray[1].name := 'Larry';
  FpplArray[1].choice := 'ORD';
  FpplArray[2].name := 'Curly';
  FpplArray[2].choice := 'ORD';

  ShowRecords;
end;

procedure TForm1.SaveAll(const aFilename: string;
  const arCrsRecords: TCrsRecordArray; const arPplRecords: TPplRecordArray);
var
  vFileS : TFileStream;
  i: integer;
begin
  vfileS := TFileStream.Create(aFileName, fmOpenWrite  or fmCreate);
  try
    for i:= Low(arCrsRecords) to High(arCrsRecords) do
      vFileS.Write(arCrsRecords[i],SizeOf(TCrsRecord));
    for i:= Low(arPplRecords) to High(arPplRecords) do
      vFileS.Write(arPplRecords[i], SizeOf(TPplRecord));
  finally
    vfileS.Free;
  end;
end;

procedure TForm1.ShowRecords;
begin
  listbox1.items.Add('arCrsRecord');
  listBox1.items.Add('');
  ListBox1.items.Add(FcrsArray[0].code + ' -- ' + FcrsArray[0].title);
  ListBox1.Items.Add(FcrsArray[1].code + ' -- ' + FcrsArray[1].title);
  ListBox1.Items.Add(FcrsArray[2].code + ' -- ' + FcrsArray[2].title);

  listbox2.items.Add('arPplRecord');
  listBox2.items.Add('');
  ListBox2.items.Add(FpplArray[0].name + ' -- ' + FpplArray[0].choice);
  ListBox2.Items.Add(FpplArray[1].name + ' -- ' + FpplArray[1].choice);
  ListBox2.Items.Add(FpplArray[2].name + ' -- ' + FpplArray[2].choice);
end;

end.

clemmi

  • Jr. Member
  • **
  • Posts: 54
Re: save open records to disk
« Reply #19 on: March 31, 2014, 12:31:36 am »
Thanks a lot! now I have to be able to modify the records on run time and see if i can save the modified records but it should be easier to implement than the previous.
You saved me a lot of time...

Can we published  this somewhere for others to find easier than digging through the forum postings? I found no previous documentation about saving/opening 2 or more records with one file name.
-cl
 

karaba

  • New Member
  • *
  • Posts: 49
Re: save open records to disk
« Reply #20 on: March 31, 2014, 01:20:44 am »
you can add an entry at the wiki, under file access methods or something along those lines. Also the forums are indexed by google so searching using their engine should bring up this thread.

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: save open records to disk
« Reply #21 on: April 01, 2014, 05:16:30 am »
I didn't see the last post until now, because it went to a new page, but I printed the wiki link and I'll digest it. - Thanks!

Maybe you can digest it with an example you'll understand.

First this unit:
Code: [Select]
unit usaving;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources;

type

  { TBookItem }

  TBookItem = class(TCollectionItem)
  private
    FCode: string;
    FTitle: string;
  public
    constructor Create(ACollection: TCollection); override;
  published
    property Code: string read FCode write FCode;
    property Title: string read FTitle write FTitle;
  end;

  { TPeopleItem }

  TPeopleItem = class(TCollectionItem)
  private
    FName: string;
    FChoice: string;
  public
    constructor Create(ACollection: TCollection); override;
  published
    property Name: string read FName write FName;
    property Choice: string read FChoice write FChoice;
  end;

  { TBookCollection }

  TBookCollection = class(TCollection)
  private
    function GetItems(Index: integer): TBookItem;
    procedure SetItems(Index: integer; AValue: TBookItem);
  public
    constructor Create;
  public
    function Add: TBookItem;
    function AddEx(aCode, aTitle: string): TBookItem;
  public
    property Items[Index: integer]: TBookItem read GetItems write SetItems; default;
  end;

  { TPeopleCollection }

  TPeopleCollection = class(TCollection)
  private
    function GetItems(Index: integer): TPeopleItem;
    procedure SetItems(Index: integer; AValue: TPeopleItem);
  public
    constructor Create;
  public
    function Add: TPeopleItem;
    function AddEx(aName, aChoice: string): TPeopleItem;
  public
    property Items[Index: integer]: TPeopleItem read GetItems write SetItems; default;
  end;

  { TBookAndPeople }

  TBookAndPeople = class(TComponent)
  private
    FBook: TBookCollection;
    FPeople: TPeopleCollection;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  public
    procedure SaveToFile(AFileName: string);
    procedure LoadFromFile(AFileName: string);
    procedure OnFindClass(Reader: TReader; const AClassName: string;
      var ComponentClass: TComponentClass);
  published
    property Book: TBookCollection read FBook write FBook;
    property People: TPeopleCollection read FPeople write FPeople;
  end;


implementation

{ TBookAndPeople }

constructor TBookAndPeople.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Book := TBookCollection.Create;
  People := TPeopleCollection.Create;
end;

destructor TBookAndPeople.Destroy;
begin
  Book.Free;
  People.Free;
  inherited Destroy;
end;

procedure TBookAndPeople.SaveToFile(AFileName: string);
var
  AStream: TMemoryStream;
begin
  AStream := TMemoryStream.Create;
  try
    WriteComponentAsTextToStream(AStream, Self);
    AStream.SaveToFile(AFileName);
  finally
    AStream.Free;
  end;
end;

procedure TBookAndPeople.LoadFromFile(AFileName: string);
var
  AStream: TMemoryStream;
begin
  AStream := TMemoryStream.Create;
  try
    AStream.LoadFromFile(AFileName);
    ReadComponentFromTextStream(AStream, TComponent(Self), @OnFindClass);
  finally
    AStream.Free;
  end;
end;

procedure TBookAndPeople.OnFindClass(Reader: TReader; const AClassName: string;
  var ComponentClass: TComponentClass);
begin
  if CompareText(AClassName, 'TBookAndPeople') = 0 then
    ComponentClass := TBookAndPeople;
end;

{ TPeopleCollection }

function TPeopleCollection.GetItems(Index: integer): TPeopleItem;
begin
  Result := TPeopleItem(inherited Items[Index]);
end;

procedure TPeopleCollection.SetItems(Index: integer; AValue: TPeopleItem);
begin
  Items[Index].Assign(AValue);
end;

constructor TPeopleCollection.Create;
begin
  inherited Create(TPeopleItem);
end;

function TPeopleCollection.Add: TPeopleItem;
begin
  Result := inherited Add as TPeopleItem;
end;

function TPeopleCollection.AddEx(aName, aChoice: string): TPeopleItem;
begin
  Result := inherited Add as TPeopleItem;
  Result.Name := aName;
  Result.Choice := aChoice;
end;

{ TBookCollection }

function TBookCollection.GetItems(Index: integer): TBookItem;
begin
  Result := TBookItem(inherited Items[Index]);
end;

procedure TBookCollection.SetItems(Index: integer; AValue: TBookItem);
begin
  Items[Index].Assign(AValue);
end;

constructor TBookCollection.Create;
begin
  inherited Create(TBookItem);
end;

function TBookCollection.Add: TBookItem;
begin
  Result := inherited Add as TBookItem;
end;

function TBookCollection.AddEx(aCode, aTitle: string): TBookItem;
begin
  Result := inherited Add as TBookItem;
  Result.Code := aCode;
  Result.Title := aTitle;
end;

{ TPeopleItem }

constructor TPeopleItem.Create(ACollection: TCollection);
begin
  if Assigned(ACollection) and (ACollection is TPeopleCollection) then
    inherited Create(ACollection);
end;

{ TBookItem }

constructor TBookItem.Create(ACollection: TCollection);
begin
  if Assigned(ACollection) and (ACollection is TBookCollection) then
    inherited Create(ACollection);
end;

end.

This form:
Code: [Select]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  usaving;//<-- this is our saving unit

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
    FData: TBookAndPeople;
  public
    { public declarations }
    property Data: TBookAndPeople read FData write FData;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Data := TBookAndPeople.Create(Self);

  with Data.Book do
  begin
    AddEx('ORD', 'Order in Chaos');
    AddEx('FBI', 'History of the FBI');
    AddEx('RAN', 'Randomnes in life');
  end;

  with Data.People do
  begin
    AddEx('Moe', 'FBI');
    AddEx('Larry', 'ORD');
    AddEx('Curly', 'ORD');
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Data.SaveToFile('data.txt');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Data.LoadFromFile('data.txt');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // Data is freed automatically
end;

end.

This output (can be binary if you change 'Text' to 'Binary' in Save/Load):
Code: [Select]
object TBookAndPeople
  Book = < 
    item
      Code = 'ORD'
      Title = 'Order in Chaos'
    end 
    item
      Code = 'FBI'
      Title = 'History of the FBI'
    end 
    item
      Code = 'RAN'
      Title = 'Randomnes in life'
    end>
  People = < 
    item
      Name = 'Moe'
      Choice = 'FBI'
    end 
    item
      Name = 'Larry'
      Choice = 'ORD'
    end 
    item
      Name = 'Curly'
      Choice = 'ORD'
    end>
end

And when you finish maybe you're interested on using Generics, for example, if you want to add more collections quickly: http://wiki.lazarus.freepascal.org/TCollection#Generics
« Last Edit: April 01, 2014, 12:08:58 pm by 007 »

 

TinyPortal © 2005-2018