Delphi - Store and read 2d array from text file [duplicate] - arrays

This question already has answers here:
How do I save the contents of this 2d array to a file
(3 answers)
Closed 7 years ago.
I am trying to store a 2d array which holds characters, into a text file which is in the comma separated values (CSV) format. I have been semi able to store the array into the text file but i dont think it will allow for it to be read back as there is no new line at the end of the end of each line where the end of the array would be (Board[1][8]) for an example. I have been unable to read the informatoin back into the array.
This is my code for storing the array into the text file
Const
BoardDimension = 8;
Type
TBoard = Array[1..BoardDimension, 1..BoardDimension] Of String;
procedure SaveGame(Board : Tboard);
var
FileNm : Textfile;
RankCount : Integer;
FileCount : Integer;
begin
Assignfile(Filenm, 'SavedGame.txt');
Rewrite(Filenm);
for RankCount :=1 to BoardDimension do
begin
for FileCount := 1 to BoardDimension-1 do
begin
write(Filenm,Board[RankCount,FileCount],',');
end;
write(Filenm,Board[RankCount,BoardDimension]);
end;
CloseFile(filenm);
writeln('game saved');
end;
this is my code for reading the text file back, but i am getting an error which states that the function Copy2SymbDel is undeclared but i have included strutils in the using statement
procedure LoadGame(Var Board :TBoard);
var
Filenm : TextFile;
RankCount : Integer;
FileCount : Integer;
Text : String;
begin
AssignFile(Filenm, 'SavedGame.txt');
reset(Filenm);
for RankCount := 1 to BoardDimension do
begin
readln(Filenm,text);
for FileCount := 1 to BoardDimension -1 do
begin
Board[RankCount,FileCount] := Copy2SymbDel(Text, ',');
end;
Board[RankCount,BoardDimension] := Text;
end;
end;
How can I store and read back a 2d array in delphi/pascal
Thank you

Copy2SymbDel is a FreePascal library function that is not available in Delphi. It is described like this:
function Copy2SymbDel(
var S: string;
Symb: Char
):string;
Description
Copy2SymbDel determines the position of the first occurrence of Symb
in the string S and returns all characters up to this position. The
Symb character itself is not included in the result string. All
returned characters and the Symb character, are deleted from the
string S, after which it is right-trimmed. If Symb does not appear in
S, then the whole of S is returned, and S itself is emptied.
In Delphi the function could be implemented like this:
function Copy2SymbDel(var S: string; Symb: Char): string;
var
I: Integer;
begin
I := Pos(Symb, S);
if I = 0 then
begin
Result := S;
S := '';
end
else
begin
Result := Copy(S, 1, I-1);
S := TrimRight(Copy(S, I+1, MaxInt));
end;
end;

Related

How to output an array that has nested arrays in Pascal

I'm creating a basic concept of a music player using Pascal, but I'm struggling to display the albums inside it. The error I got says "(134, 29) Error: Can't read or write variables of this type". I'm assuming it's saying that because I'm using an array within an array, and it's having a hard time displaying both at the same time (although I only want it to display the albums, not the tracks as well).
Here's what my code looks like:
function ReadAllTrack(prompt: String): Tracks;
var
i: Integer;
trackArray: Array of Track;
trackCount: Integer;
begin
WriteLn(prompt);
trackCount := ReadIntegerGreaterThan1('Please enter the number of tracks you would like to add: ');
Setlength(trackArray, trackCount);
for i := 0 to trackCount - 1 do
begin
WriteLn('Enter the details for your track:');
trackArray[i] := ReadTrack();
end;
result := trackArray;
end;
function ReadAlbum(): Album;
begin
result.albumName := ReadString('Album name: ');
result.artistName := ReadString('Artist name: ');
result.albumGenre := ReadGenre('Genre:');
result.trackCollection := ReadAllTrack('Track Collection:');
end;
function ReadAllAlbums(): Albums;
var
i: Integer;
albumArray: Array of Album;
albumCount: Integer;
begin
albumCount := ReadIntegerGreaterThan1('Please enter the number of albums you would like to add: ');
Setlength(albumArray, albumCount);
for i := 0 to albumCount - 1 do
begin
WriteLn('Enter the details for your album:');
albumArray[i] := ReadAlbum();
end;
result := albumArray;
end;
procedure DisplayAlbumOptions(listOfAllAlbums: Albums);
var
userInput: Integer;
begin
WriteLn('1. Display all albums');
WriteLn('2. Display all albums for a genre');
userInput := ReadIntegerRange('Please enter a number (1, 2) to select: ', 1, 2);
case userInput of
1: WriteLn(listOfAllAlbums); //Error: Can't read or write variables of this type
end;
end;
Basically what this does is it will ask the user showing 5 options:
1. Add albums
2. Display albums
etc
If the user selects 1, the program will ask the user to input the number of albums they want to input. Then for each album it'll ask them to enter the details, and then the tracks.
Then if the user selects 2, the program will ask the user to choose either display every single album there is, or display all albums for a single genre (I'll be working on this one after solving this problem). At first I thought it would be just as simple as WriteLn(TheAlbumArray); but turns out it was more complicated than I thought because I don't think it's possible for the program to display it this way. I tried separating the albums and tracks so that it would only display the albums when I use WriteLn(TheAlbumArray); but it wasn't possible because the tracks still have to be "inside" the album so that when I display the albums and select one of them, it would then display the tracks....
Any help or suggestion for this and/or the second will be much appreciated ^^
Your original question contained a lot of superfluous detail. After the edit, you removed the type declarations, but kept much of the superfluous detail.
However, it is possible to discern the problem you are passing an array of record to Writeln. The Writeln function can accept only certain simple types as arguments, e.g. strings, numerical types, boolean. You certainly cannot pass an array to Writeln. You must iterate over the array and process each member individually.
So you might try
for i := low(listOfAllAlbums) to high(listOfAllAlbums) do
WriteLn(listOfAllAlbums[i]);
But that does not work either, because listOfAllAlbums[i] is a record, and a record is a compound type which cannot be passed to Writeln. So you need to process the record separately. If you want to display just the title, then you write:
for i := low(listOfAllAlbums) to high(listOfAllAlbums) do
WriteLn(listOfAllAlbums[i].albumName);
If you want to print the track titles too then you need to iterate over the array contained in the record.
for i := low(listOfAllAlbums) to high(listOfAllAlbums) do
begin
WriteLn(listOfAllAlbums[i].albumName);
for j := low(trackCollection) to high(trackCollection) do
WriteLn(listOfAllAlbums[i].trackCollection[j]);
end;
It is impossible to use composite types (arrays, records, ...) in Read[ln] and Write[ln] procedures.
To make your code more transparent you could to create type helper for your array(s) and use well-known AsString property. Here is example for simple array of Integer:
program foo;
{$mode objfpc}{$H+}
{$modeswitch typehelpers}
uses
Classes, SysUtils;
type
TMyArray = array of Integer;
TMyArrayHelper = type helper for TMyArray
private
function GetAsString: string;
procedure SetAsString(const AValue: string);
public
property AsString: string read GetAsString write SetAsString;
end;
function TMyArrayHelper.GetAsString: string;
var
i: Integer;
begin
Result := '';
for i in Self do
begin
if Result <> '' then
Result := Result + ', ';
Result := Result + IntToStr(i);
end;
Result := '[' + Result + ']';
end;
// Relatively simple parser
// Fill free to implement ones for your array type
procedure TMyArrayHelper.SetAsString(const AValue: string);
var
tmp, s: string;
items: TStringArray;
i: Integer;
begin
tmp := Trim(AValue);
if not (tmp.StartsWith('[') and tmp.EndsWith(']')) then
raise Exception.CreateFmt('Invalid array literal format: "%s"', [tmp]);
tmp := tmp.Trim(['[', ']']);
items := tmp.Split([',']);
for s in items do
try
StrToInt(s);
except
on e: Exception do
raise Exception.CreateFmt('Invalid integer literal: "%s"', [s]);
end;
SetLength(Self, Length(items));
for i := 0 to Length(items) - 1 do
Self[i] := StrToInt(items[i]);
end;
var
a1, a2: TMyArray;
begin
a1.AsString := '[1,2,3,5]';
Writeln('a1 = ', a1.AsString);
a2.AsString := a1.AsString;
a2[1] := 999;
Writeln('a2 = ', a2.AsString);
end.
Helper types in FreePascal
TStringHelper in SysUtils unit

Delphi - Re-split an array of string?

Let's say I have a string like this :
string1 := 'me,email1,you,email2,him,email3,them,email4';
To turn this into an array of string I simply do :
array1 := SplitString(string1,',');
This works fine.
But then, I get an array like :
array1[0] -> me
array1[1] -> email1
array1[2] -> you
array1[3] -> email2
array1[4] -> him
array1[5] -> email3
array1[6] -> them
array1[7] -> email4
I've searched a long time how to insert into SQLIte with this but there is no using
for i:= 0 to length(array1) -1
SQLExecute('INSERT INTO table(name,email) VALUES("'+array1[i]+'","'+array1[i+1]+'"');
because index 0 will be inserted as name with index 1 as email, but on the next turn, index 1 will be inserted as name with index 2 as email, when index 1 is en email, and index 2 a name... do you see the problem ?
I thought about re-spliting the first array into a second one by changing the initial string format into :
string1 := 'me-email1,you-email2,him-email3,them-email4';
to split a first time on the ' and a second time on the -, to get a 2 dimensional array, but seems this concept is over my knowledge at the moment :)
Just for the record, the Delphi RAD I'm using is quite recent, and only a few functions / tools are available at the moment.
How would you insert into sql ? Would you keep the original String format, or change it to get a 2 dimensional array ?
Iterate in pairs:
for i := 0 to length(array1) div 2 - 1 do
SQLExecute('INSERT INTO table(name,email) VALUES("'+array1[i*2]+'","'+array1[i*2+1]+'"');
You just should not use per-INSERT FOR-loop here.
It is not suited for it and it is dangerous if your string would have 3 or 7 or any other odd number of elements.
Also splicing random data right into the SQL command is extremely unreliable and fragile. http://bobby-tables.com/
You should either use a WHILE-loop with a sliding fetcher or tick-tock (finite state machine) swinging in one-per-string FOR-loop.
var q: TQuery;
// some Query-component of any library,
// including DBX, AnyDAC/ FireDAC mORMot or any other library you would use
var sa_OK, sa_err1, sa_err2: TArray<string>;
// common preparations for both methods
q.ParamCheck := True;
q.SQL.Text := 'INSERT INTO table(name,email) VALUES( :PName, :PMail )';
q.Prepared := True;
sa_OK := TArray<string>.Create( 'me','email1','you','email2','him','email3','them','email4');
// eeeaaasy example
sa_err1 := TArray<string>.Create( 'me','email1','you','email2','him');
// check this out-of-sync error too - it can happen! you should be pre-aware!
sa_err2 := TArray<string>.Create( 'Sarah O''Connor','email1','"Bobby F. Kennedy"','email2','him'#0'again','email3');
// not the letters you expected - but they can come too
Procedure Method1_Fetcher( const sa: array of string );
var i: integer;
s: string;
function Fetched: Boolean;
begin
Result := i <= High(sa);
if Result then begin
s := sa[i];
Inc(i);
end;
end;
Begin
i := Low(sa);
while true do begin
if not Fetched then break;
q.Params[1].AsWideString := s;
if not Fetched then break;
q.Params[2].AsWideString := s;
// ...you can easily add more parameters for more columns
// if not Fetched then break;
// q.Params[3].Value := s;
// ... or you can make a loop
// FOR j := 0 to q.Params.Count - 1 DO ... q.Params[j] :=...
// only executing insert if ALL the columns were filled
q.ExecSQL;
end;
q.Transaction.CommitWork;
End;
Procedure Method2_TickTock( const sa: array of string );
var i, FSM: integer;
Begin
FSM := 0;
for i := Low(sa) to High(sa) do begin
if FSM = 0 then begin
q.ParamByName('PName').AsWideString := sa[i];
FSM := 1; // next mode of tick-tock
Continue;
end;
if FSM = 1 then begin
q.ParamByName('PMail').AsWideString := sa[i];
q.ExecSQL;
// only executing insert after the last column was filled
FSM := 0; // next mode of tick-tock
Continue;
end;
/// would only come here if we made some mistake above
/// and FSM got impossible value - so no "Continue" was executed
/// show error and exit
raise EInvalidOperation.CreateFmt('FSM = %d', [FSM]);
end;
q.Transaction.CommitWork;
End;
Procedure Method3_SimplifiedFSM( const sa: array of string );
// this method is actually are streamlined method #2
// it can be made because all our steps are TOTALLY identical
// ( sans optional insert execution )
var i, FSM: integer;
Begin
FSM := 0;
for i := Low(sa) to High(sa) do begin
q.Params[ FSM ].AsWideString := sa[i];
Inc( FSM );
if FSM >= q.Params.Count then begin
q.ExecSQL; // only after (if ) last of all columns filled!
FSM := 0;
end;
end;
q.Transaction.CommitWork;
End;
Now you can debug calls like Method1(sa_OK) or Method2(sa_err1) and see how it is working and how it deals with errors

Parsing/Splitting a string doesn't return all the parts

I have a procedure that I found from another question that supposedly splits/delimits a string , when provided a string, a delimiter, and and a TStrings list. That procedure is:
procedure SplitString(const Delimiter: Char; Input: string; const Strings: TStrings);
begin
//Delimits or splits the received string, returns TStrings array
Assert(Assigned(Strings)) ;
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
However when I provided it this:
SplitString('=',test,EqualParse);
Where test is a string 200 : NCPATH -------------> = C:\SNDATA\NC\ and EqualParse is a TStringList, all that I get back is 200 for EqualParse[0] (which should be everything to the left of the equal sign. I am expecting to get back 200 : NCPATH ------------->. Is there something wrong with how I am using that code? Can I modify is to also not split by a space if not explicitly done?
You need to set TStrings.StrictDelimiter to True, otherwise DelimitedText includes whitespace as a delimiter.
procedure SplitString(const Delimiter: Char; Input: string; const Strings: TStrings);
begin
//Delimits or splits the received string, returns TStrings array
Assert(Assigned(Strings)) ;
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.StrictDelimiter := True; // <-- add this
Strings.DelimitedText := Input;
end;
This is documented behavior:
If StrictDelimiter is set to False, the space character is also interpreted as a delimiter, regardless of the value of Delimiter.
With that said, setting the delimiter properties of the input TStrings may have unwanted side effects on the caller, so I would suggest using a local TStringList for the parsing:
procedure SplitString(const Delimiter: Char; Input: string; const Strings: TStrings);
var
Tmp: TStringList;
begin
Assert(Assigned(Strings)) ;
tmp := TStringList.Create;
try
tmp.Delimiter := Delimiter;
tmp.StrictDelimiter := True;
tmp.DelimitedText := Input;
Strings.Assign(tmp);
finally
tmp.Free;
end;
end;

Generic function to increase array of pointers

I'm working in a code that has a data structure like this:
type
TData1 = record
IntField: Integer;
StrField: string;
end;
TData2 = record
DateField: TDateTime;
StrField: string;
end;
var
AData1 = array of ^TData1;
AData2 = array of ^TData2;
Sometimes I have to add an element to one of that arrays, like this:
L := Length(AData1);
SetLength(AData1, L + 1);
New(AData1[L]);
How can I write a procedure that does that job of increasing the array size and allocating memory for a new item that works for any kind of pointer? And it must be done without changing the definitions of the records (TData1, TData2) and the arrays (AData1, AData2), so it won't break existing code.
Ps: I don't have much background with pointers and that kind of programming, I'd certainly use objects and dynamic linked lists, but in this case it's a legacy code and I can't change it, at least for now.
Update:
This is not a full answer. Using TDynArray as mentioned by David may solve your problem.
Using RTTI I made a another solution for you. It is a generic solution and you can easily add more functions/capabilities. It will preserve your type declarations. Example of adding/removing records is included.
The record TDynPtArray handles any dynamic array of pointers to records. It is initialized with an Init call:
DPA.Init(TypeInfo(TData1), AData1);
Data1 := DPA.Add; // Adds a record with default values and
// returns a pointer to the record
DPA.Remove; // Finalizes/deallocates the last record and
// shrinks the dynamic array
-
uses
Windows,System.SysUtils,System.TypInfo;
Type
TPtArray = array of Pointer;
PPtArray = ^TPtArray;
TDynPtArray = record
private
FDynArray: PPtArray;
FTypeInfo: PTypeInfo;
FTypeData: PTypeData;
public
constructor Init( T: Pointer; var dynArray);
function Add : Pointer;
procedure Remove;
procedure Clear;
end;
constructor TDynPtArray.Init(T: Pointer; var dynArray);
begin
FTypeInfo := T;
if (FTypeInfo^.Kind <> tkRecord) then
raise Exception.CreateFmt('%s is not a record',[FTypeInfo^.Name]);
FTypeData := GetTypeData( FTypeInfo);
FDynArray := #dynArray;
end;
function TDynPtArray.Add: Pointer;
var
L: integer;
begin
L := Length(FDynArray^);
SetLength(FDynArray^,L+1);
GetMem( FDynArray^[L], FTypeData^.elSize);
ZeroMemory( FDynArray^[L], FTypeData^.elSize);
Result := FDynArray^[L];
end;
procedure RecordClear(var Dest; TypeInfo: pointer);
asm
{$ifdef CPUX64}
.NOFRAME
{$endif}
jmp System.#FinalizeRecord
end;
procedure TDynPtArray.Remove;
var
L: integer;
begin
L := Length(FDynArray^);
if (L = 0) then
exit;
RecordClear( FDynArray^[L-1]^,FTypeInfo); // Finalize record
FreeMem( FDynArray^[L-1], FTypeData^.elSize);
SetLength(FDynArray^,L-1);
end;
procedure TDynPtArray.Clear;
begin
while (Length(FDynArray^) <> 0) do
Self.Remove;
end;
And a little test:
type
PData1 = ^TData1;
TData1 = record
IntField: Integer;
StrField: string;
end;
TData1Arr = array of PData1;
var
AData1: TData1Arr;
Data1: PData1;
DPA: TDynPtArray;
begin
DPA.Init(TypeInfo(TData1), AData1);
Data1:= DPA.Add;
Data1^.StrField := '111';
WriteLn(Data1^.IntField);
WriteLn(Data1^.StrField);
DPA.Clear;
ReadLn;
end.

string to byte array and array of bytes to file

I need to implement in Delphi 2006 an algoritm that work in .net
Basicaly I need to do the next steps:
Create an XML and validate aganist the XSD
Serialize the XML string into an array of bytes UTF-8 encoded and compress it with zip
The compressed info must be stored again into a array of bytes using base256 format
Create an image using Datamatrix 2D BarCode from this array of bytes and put this image on a report
For step 1, I create the XML using NativeXML library that work ok. In this library exist a metod SaveToBinaryFile but don't work ok. In my tests I used this function to create a binary file.
I was forced to use a binary file becouse my Zip component work only with files not with strings or aray of bytes from memory.
I compressed this binary file with the Zip component and loaded this compresed file into a blob file.
At the moment when I need to create the DataMatrix image I load this blob file into an ansistring and I create the image.
After many tests I found that my fault is when I save my XML into the binary file.
Now I need to found another way to save my xml (utf-8) string to a binarry file.
Please sorry for my english.
Can anyone help me?
procedure CreateXMLBarcodeș
var
BinarySize: Integer;
InputString: utf8string;
StringAsBytes: array of Byte;
F : FIle of Byte;
pTemp : Pointer;
begin
InputString := '';
ADoc := TNativeXml.CreateName(rootName);
try
... //create the XML
InputString := ADoc.WriteToLocalString; //utf8string
if InputString > '' then begin
//serialize the XML string to array of bytes
BinarySize := (Length(InputString) + 1) * SizeOf(Char);
SetLength(StringAsBytes, BinarySize);
Move(InputString[1], StringAsBytes[0], BinarySize);
//save the array of bytes to file
AssignFile( F, xmlFilename );
Rewrite(F);
try
BinarySize := Length( StringAsBytes );
pTemp := #StringAsBytes[0];
BlockWrite(F, pTemp^, BinarySize );
finally
CloseFile( F );
end;
end;
finally
ADoc.Free;
end;
end
...
//in other procedure:
DataSet1XMLBarCode.LoadFromFile(CreateXMLBarcode);
...
//when I want to create the report
//create the DataMatrix image
procedure xyz(Sender: TfrxReportComponent);
var AWidth, AHeight: Integer;
function GetStringFromBlob: AnsiString;
var BlobStream: TStream;
begin
Result := '';
DataSet.Open;
BlobStream := DataSet1.
CreateBlobStream(DataSet1XMLBarCode, bmRead);
try
SetLength(Result, BlobStream.Size);
BlobStream.Position := 0;
BlobStream.Read(Result[1], BlobStream.Size);
finally
BlobStream.Free;
end;
DataSet.Close;
end;
begin
Barcode2D_DataMatrixEcc2001.Locked := True;
Barcode2D_DataMatrixEcc2001.Barcode := GetStringFromBlob;
Barcode2D_DataMatrixEcc2001.Module := 1;
Barcode2D_DataMatrixEcc2001.DrawToSize(AWidth, AHeight);
with TfrxPictureView(frxReport1.FindObject('Picture1')).Picture.Bitmap do
begin
Width := AWidth;
Height := AHeight;
Barcode2D_DataMatrixEcc2001.DrawTo(Canvas, 0, 0);
end;
Barcode2D_DataMatrixEcc2001.Locked := False;
end;
//the code was 'çopied'and adapted from the internet

Resources