Delphi - Re-split an array of string? - arrays

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

Related

Dataset not in edit or insert mode

Im a new user of stack overflow. I have a big project coming up and i keep getting the same error. I’m trying to load data into my database and no matter how many times I try or what I change I still get the same errors. I have labled nessarry variables, tried tbl().Edit and tbl().Insert inside, outside of my loops and in the case statement but i still seem to be getting the same error.
sPlayer1,sPlayer2, iScore1,iScore2 are global variables.
`
procedure TfrmInvigilator.btnSubmitClick(Sender: TObject);
Var
i, j, iRound: Integer;
begin
sPlayer1 := cmbName1.Text; // Assigning values to variables for cmbPlayers
sPlayer2 := cmbName2.Text;
iScore1 := sedScore1.Value; // Assigning values to variables for sedScores
iScore2 := sedScore2.Value;
iRound := cmbRound.ItemIndex; // Assigning values to variable for cmbRound
if (cmbName1.ItemIndex = -1) then
// Displays show message if cbmName1 is blank
begin
ShowMessage('Please select player name');
end
else
begin // If cbmName1 is not blank then:
i := pos(' ', sPlayer1); // Find position of ' ' in cbmName1.Text
sPlayer1 := Copy(sPlayer1, 1, i - 1); // sPlayer1 := Name of player
dmChess.tblPlayerInfo.Locate('Name', sPlayer1, []); // Locates Name in table
Num1 := dmChess.tblPlayerInfo['ID']; // Retrives ID of player
with dmChess do
begin
tblScoreboard.First;
while NOT tblScoreboard.EOF do
begin
tblScoreboard.Locate('ID', Num1, []);
case iRound of
0:
tblScoreboard['Round 1A'] := iScore1;
1:
tblScoreboard['Round 1B'] := iScore1;
2:
tblScoreboard['Round 1C'] := iScore1;
3:
tblScoreboard['Round 1D'] := iScore1;
4:
tblScoreboard['Round 2'] := iScore1;
5:
tblScoreboard['Semi-Final'] := iScore1;
6:
tblScoreboard['Final'] := iScore1;
end;
tblScoreboard.Post;
end;
end;
end;
if (cmbName2.ItemIndex = -1) then
// Displays show message if cbmName2 is blank
begin
ShowMessage('Please slecet player name');
end
else
begin // If cbmName2 is not blank then:
j := pos(' ', sPlayer2); // Find position of ' ' in cbmName2.Text
sPlayer2 := Copy(sPlayer2, 1, j - 1); // sPlayer2 := Name of player
dmChess.tblPlayerInfo.Locate('Name', sPlayer2, []); // Locates Name in table
Num1 := dmChess.tblPlayerInfo['ID']; // Retrives ID of player
end;
end;
`
You can't just set a new value in a DataSet field (table or query), the DataSet must know that you want to change the current record or insert a new one. An exception tells you this. How to solve: before you make changes to any field in the dataset, you need to set the desired mode. DataSet.edit; - to edit the current record, DataSet.Insert - to insert a new record in the current location, DataSet.Append - to add a new record to the end. For this code snippet, add the line tblScoreboard.Edit; after the line tblScoreboard.Locate('ID', Num1, []);
DataSet.Post – save current changes into record and change DataSet mode back to Browsing

How to copy an OleVariant array efficiently to my own structure?

I am trying to copy an OleVariant array to my own structure. I received the OleVariant from an external COM call.
The size is 1000 x 500 elements (I don't know if its the same as this Structure Definition: array of array of OleVariant).
Currently, I am trying to achieve something like:
result := Copy(Source, Amount)
But the OleVariant structure is in my way.
If I use a "classical" loop, it works, but it is slow (very slow).
aResult is currently defined as TData = array of array of string;
procedure CopyResult(aResultCount: Integer; var aResult: TData; aSource: Variant);
var
i, j: Integer;
bVariantConversion: boolean;
begin
SetLength(aResult, aResultCount, VarArrayHighBound(aSource[0], 1));
bVariantConversion := NullStrictConvert; // settings to manage how string conversion for Variant is handled.
NullStrictConvert := False;
try
for i := VarArrayLowBound(aSource, 1) to VarArrayHighBound(aSource, 1) do
begin
for j := VarArrayLowBound(aSource[i], 1) to pred(VarArrayHighBound(aSource[i], 1)) do
begin
//nearly every execution pause is somewhere in this String Conversion or Array Function.
aResult[i][j] := aSource[i][j]; //implicit conversion to string ...
end;
end;
finally
NullStrictConvert := bVariantConversion;
end;
end;
As #Remy Lebau mentioned the bounds Check for the Vararray[x][y] access is the routine my source burns its time. I am trying to eliminate this kind of acces by going directly to the OleVariantArray Elements.
Aftermath...
trying to Determine my Structure i think i found the Root.
tmyVarType := VarType(aSource); //8204 => Array(VT_ARRAY = 0x2000 = 8192) + variant(VT_VARIANT = 0x000C = 12)
tmyVarType := VarType(aSource[0]); //8204
tmyVarType := VarType(aSource[0][0]); //3 VT_I4 = 0x0003 = 3 is integer and this is correctly changin for the fields.
So i try to acess the Source without the build in functions to avoid the bounds check.
The biggest bottleneck in this code is the bounds checking performed by the [] operator on each Variant array, and potentially on your aResult array, too. Since you are already handling the bounds in each loop, there is no need to verify the bounds inside of the loops as well.
So, if performance is an issue for you, then you can use VarArrayLock() to access the underlying Variant elements in each array, using pointer arithmetic to move between them, eliminating those redundant bounds checks.
You should also reduce the redundant calls to VarArray(Low|High)Bound(aSource[i], 1) on each iteration of the outer array, since you claim the inner arrays all have the same length. So you can calculate that up front before entering the loops.
Try something like this:
type
TStrArr = array of string;
PStrArr = ^TStrArr;
TData = array of TStrArr;
procedure CopyResult(aResultCount: Integer; var aResult: TData; aSource: Variant);
var
i, j,
OuterLBound, OuterHBound, OuterCount,
InnerLBound, InnerHBound, InnerCount: Integer;
pOuterVarArr, pInnerVarArr: PVariant;
pOuterDynArr: PStrArr;
pInnerDynArr: PString;
bVariantConversion: boolean;
begin
aResult := nil;
Assert(VarIsType(aSource, varArray or varVariant));
Assert(VarArrayDimCount(aSource) = 1);
OuterLBound := VarArrayLowBound(aSource, 1);
OuterHBound := VarArrayHighBound(aSource, 1);
OuterCount := {aResultCount} OuterHBound - OuterLBound + 1;
if OuterCount < 1 then Exit;
Assert(VarIsType(aSource[0], varArray or varVariant));
Assert(VarArrayDimCount(aSource[0]) = 1);
InnerLBound := VarArrayLowBound(aSource[0], 1);
InnerHBound := VarArrayHighBound(aSource[0], 1);
InnerCount := InnerHBound - InnerLBound + 1;
SetLength(aResult, {aResultCount} OuterCount, InnerCount);
bVariantConversion := NullStrictConvert; // settings to manage how string conversion for Variant is handled.
NullStrictConvert := False;
try
pOuterDynArr := PStrArr(aResult);
pOuterVarArr := PVariant(VarArrayLock(aSource));
try
for i := OuterLBound to OuterHBound do
begin
pInnerDynArr := PString(pOuterDynArr^);
pInnerVarArr := PVariant(VarArrayLock(pOuterVarArr^));
try
//System.Variants.DynArrayFromVariant(pOuterDynArr^, pInnerVarArr^, TypeInfo(String));
for j := InnerLBound to InnerHBound do
begin
pInnerDynArr^ := pInnerVarArr^; //implicit conversion to string ...
Inc(pInnerDynArr);
Inc(pInnerVarArr);
end;
finally
VarArrayUnlock(pOuterVarArr^);
end;
Inc(pOuterDynArr);
Inc(pOuterVarArr);
end;
finally
VarArrayUnlock(aSource);
end;
finally
NullStrictConvert := bVariantConversion;
end;
end;
On the other hand, if there is ever a chance that the inner arrays have different lengths, then you can try this adjustment instead:
type
TStrArr = array of string;
PStrArr = ^TStrArr;
TData = array of TStrArr;
procedure CopyResult(aResultCount: Integer; var aResult: TData; aSource: Variant);
var
i, j,
OuterLBound, OuterHBound, OuterCount,
InnerLBound, InnerHBound, InnerCount: Integer;
pOuterVarArr, pInnerVarArr: PVariant;
pOuterDynArr: PStrArr;
pInnerDynArry: PString;
bVariantConversion: boolean;
begin
aResult := nil;
Assert(VarIsType(aSource, varArray or varVariant);
Assert(VarArrayDimCount(aSource) = 1);
OuterLBound := VarArrayLowBound(aSource, 1);
OuterHBound := VarArrayHighBound(aSource, 1);
OuterCount := {aResultCount} OuterHBound - OuterLBound + 1;
if OuterCount < 1 then Exit;
SetLength(aResult, {aResultCount} OuterCount);
bVariantConversion := NullStrictConvert; // settings to manage how string conversion for Variant is handled.
NullStrictConvert := False;
try
pOuterDynArr := PStrArr(aResult);
pOuterVarArr := PVariant(VarArrayLock(aSource));
try
for i := OuterLBound to OuterHBound do
begin
pInnerVarArr := PVariant(VarArrayLock(pOuterVarArr^));
try
//System.Variants.DynArrayFromVariant(pOuterDynArr^, pInnerVarArr^, TypeInfo(String));
Assert(VarIsType(pInnerVarArr^, varArray or varVariant);
Assert(VarArrayDimCount(pInnerVarArr^) = 1);
InnerLBound := VarArrayLowBound(pInnerVarArr^, 1);
InnerHBound := VarArrayHighBound(pInnerVarArr^, 1);
InnerCount := InnerHBound - InnerLBound + 1;
SetLength(pOuterDynArr^, InnerCount);
pInnerDynArr := PString(pOuterDynArr^);
for j := InnerLBound to InnerHBound do
begin
pInnerDynArr^ := pInnerVarArr^; //implicit conversion to string ...
Inc(pInnerDynArr);
Inc(pInnerVarArr);
end;
finally
VarArrayUnlock(pOuterVarArr^);
end;
Inc(pOuterDynArr);
Inc(pOuterVarArr);
end;
finally
VarArrayUnlock(aSource);
end;
finally
NullStrictConvert := bVariantConversion;
end;
end;
Edit: I Only tested the Source version for all Entrys the same length but it works my own partial [] free Version used ~5 Million cycles with Tstopwatch ElapsedTicks and this one only took around ~2 Millon (more like 1.6) Thanks

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

How to align 2 arrays without temporary arrays?

I have 2 arrays that I need to align lines. I prepare the 'control' array which has the info on how to align arrays and then I do it, with help of temp arrays.
See in picture the arrays and result as aligned arrays:
Here is the code that I use, as MCVE:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
System.Math,
System.Generics.Defaults,
System.Generics.Collections;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TSide = (sLeft, sRight, sBoth);
TData = record
DataID: integer;
DataName: string;
BlankLine: boolean;
end;
TCtrlData = record
Side: TSide;
Idx_l: integer;
Idx_r: integer;
end;
var
Form1: TForm1;
aLeft, aRight, aLeft_tmp, aRight_tmp: TArray<TData>; // main and temp arrays
aCtrl: TArray<TCtrlData>; // control array with instructions o nhow to align lines
implementation
{$R *.dfm}
procedure PrepareData;
begin
// prepare data
SetLength(aLeft, 4);
aLeft[0].DataID := 1; aLeft[0].DataName := 'One';
aLeft[1].DataID := 2; aLeft[1].DataName := 'Three';
aLeft[2].DataID := 3; aLeft[2].DataName := 'Six';
aLeft[3].DataID := 4; aLeft[3].DataName := 'Eight';
SetLength(aRight, 6);
aRight[0].DataID := 1; aRight[0].DataName := 'One';
aRight[1].DataID := 2; aRight[1].DataName := 'Two';
aRight[2].DataID := 3; aRight[2].DataName := 'Four';
aRight[3].DataID := 4; aRight[3].DataName := 'Five';
aRight[4].DataID := 5; aRight[4].DataName := 'Seven';
aRight[5].DataID := 6; aRight[5].DataName := 'Eight';
// do the magic - prepare control array
SetLength(aCtrl, 8);
aCtrl[0].Side := sBoth; aCtrl[0].Idx_L := 0; aCtrl[0].Idx_R := 0;
aCtrl[1].Side := sRight; aCtrl[1].Idx_R := 1;
aCtrl[2].Side := sLeft; aCtrl[2].Idx_L := 1;
aCtrl[3].Side := sRight; aCtrl[3].Idx_R := 2;
aCtrl[4].Side := sRight; aCtrl[4].Idx_R := 3;
aCtrl[5].Side := sLeft; aCtrl[5].Idx_L := 2;
aCtrl[6].Side := sRight; aCtrl[6].Idx_R := 4;
aCtrl[7].Side := sBoth; aCtrl[7].Idx_L := 3; aCtrl[7].Idx_R := 5;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i, vIndex: integer;
begin
PrepareData;
{ prepare arrays based on Control array
Loop through Control array and fill temp arrays from Left or Right arrays }
SetLength(aLeft_tmp, 0);
SetLength(aRight_tmp, 0);
SetLength(aLeft_tmp, Length(aCtrl));
SetLength(aRight_tmp, Length(aCtrl));
vIndex := 0;
for i := 0 to High(aCtrl) do
begin
if aCtrl[i].Side = sBoth then // Data from Both
begin
aLeft_tmp[vIndex] := aLeft[aCtrl[i].Idx_L];
aRight_tmp[vIndex] := aRight[aCtrl[i].Idx_R];
Inc(vIndex);
end;
if aCtrl[i].Side = sLeft then // Data from Left side
begin
aLeft_tmp[vIndex] := aLeft[aCtrl[i].Idx_L];
aRight_tmp[vIndex].BlankLine := true;
Inc(vIndex);
end;
if aCtrl[i].Side = sRight then // Data from Right side
begin
aRight_tmp[vIndex] := aRight[aCtrl[i].Idx_R];
aLeft_tmp[vIndex].BlankLine := true;
Inc(vIndex);
end;
end;
// Assign aligned data to main arrays
aLeft := aLeft_tmp;
aRight := aRight_tmp;
end;
As I use the same or similar code for a lot of arrays, I'm trying to refactor and simplify it with AlignArrays function:
procedure AlignArrays(vCtrl: TArray<TCtrlData>; var vLeft, vRight: TArray<TData>);
var
i, vIndex: integer;
vLeft_tmp, vRight_tmp: TArray<TData>;
begin
SetLength(vLeft_tmp, Length(vCtrl));
SetLength(vRight_tmp, Length(vCtrl));
vIndex := 0;
{ prepare arrays based on Control array
Loop through Control array and fill temp arrays from Left or Right arrays }
for i := 0 to High(vCtrl) do
begin
if vCtrl[i].Side = sBoth then // Data from Both
begin
vLeft_tmp[vIndex] := vLeft[vCtrl[i].Idx_L];
vRight_tmp[vIndex] := vRight[vCtrl[i].Idx_R];
Inc(vIndex);
end;
if vCtrl[i].Side = sLeft then // Data from Left side
begin
vLeft_tmp[vIndex] := vLeft[vCtrl[i].Idx_L];
vRight_tmp[vIndex].BlankLine := true;
Inc(vIndex);
end;
if vCtrl[i].Side = sRight then // Data from Right side
begin
vRight_tmp[vIndex] := vRight[vCtrl[i].Idx_R];
vLeft_tmp[vIndex].BlankLine := true;
Inc(vIndex);
end;
end;
vLeft := vLeft_tmp;
vRight := vRight_tmp;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, vIndex: integer;
begin
PrepareData;
AlignArrays(aCtrl, aLeft, aRight);
end;
Question: Can this be better refactored and is it possible to work on the arrays without temp arrays?
EDIT:
From comments and answers it seems I waste too much time preparing MCVE, I should better explain the problem I have. But, from an CleoR's answer I got an idea to align arrays by starting in he last line and aligning to the top. Adn it seems to work, and here is why:
Because control array has instructions on how to align lines, I know exactly what the size of arrays is. And since aligning means 'stretchin' array/inserting new blank lines where needed, if I start from the bottom up, I don't need to insert anything, only move the lines that need to be moved.
Simple and it works - without temp arrays:
procedure AlignArraysBackwards(vCtrl: TArray<TCtrlData>; var vLeft, vRight: TArray<TData>);
var
i: integer;
vBlankRecord:TData;
begin
// set blank record to blank out the moved line
vBlankRecord.DataID:=0;
vBlankRecord.DataName:='';
vBlankRecord.BlankLine:=True;
// set lenght for arrays
SetLength(vLeft, Length(vCtrl));
SetLength(vRight, Length(vCtrl));
// align - starting from the bottom up
for i := High(vCtrl) downto 0 do
begin
if vCtrl[i].Side = sBoth then // Data from Both
begin
// move Left line
vLeft[i] := vLeft[vCtrl[i].Idx_L];
// blank out the line we just moved
if vCtrl[i].Idx_L<>i then vLeft[vCtrl[i].Idx_L]:=vBlankRecord;
// move Rigth line
vRight[i] := vRight[vCtrl[i].Idx_R];
// blank out the line we copied from
if vCtrl[i].Idx_R<>i then vRight[vCtrl[i].Idx_R]:=vBlankRecord;
end;
if vCtrl[i].Side = sLeft then // Data from Left side
begin
// move Left line
vLeft[i] := vLeft[vCtrl[i].Idx_L];
// blank out the line we just moved
if vCtrl[i].Idx_L<>i then vLeft[vCtrl[i].Idx_L]:=vBlankRecord;
// blank Right line
vRight[i].BlankLine := true;
end;
if vCtrl[i].Side = sRight then // Data from Right side
begin
// move Left line
vRight[i] := vRight[vCtrl[i].Idx_R];
// blank out the line we just moved
if vCtrl[i].Idx_R<>i then vRight[vCtrl[i].Idx_R]:=vBlankRecord;
// blank Left line
vLeft[i].BlankLine := true;
end;
end;
end;
UPDATE: Changed the solution to pseudocode.
You don't need a temp array, you can do it in place.
Lets assume the left and right arrays have enough space and they are the same size.
For each array you'll need to keep track of the last element in the array. Lets call this the dataPointer. Reverse loop over the arrays with a counter called endPointer.
At each step in the loop check if array[dataPointer] == endPointer + minElement for both arrays.
If true, array[endPointer] = endPointer + minElement and decrement the dataPointer.
If false, array[endPointer] = skip_value.
Do this until endPointer goes past the beginning of the array.
skip_value = 0
//Handles our assumptions.
function setup(left,right)
left.sort()
right.sort()
ldPointer = len(left)-1
rdPointer = len(right)-1
maxElement = max(left[ldPointer],right[rdPointer])
//This is 1 in your examples. You can hard code this number.
minElement = min(left[0],right[0])
padLength = maxElement - minElement + 1
pad(left,padLength)
pad(right,padLength)
return ldPointer,rdPointer,minElement
//Aligns the arrays.
function align(left,right)
ldPointer,rdPointer,minElement = setup(left,right)
for endPointer = len(left)-1; endPointer >= 0; i--
//Look at the left element.
if left[ldPointer] == endPointer+minElement
left[endPointer] = endPointer+minElement
ldPointer = ldPointer - 1
else
left[endPointer] = skip_value
//Look at the right element.
if right[rdPointer] == endPointer+minElement
right[endPointer] = endPointer+minElement
rdPointer = rdPointer - 1
else
right[endPointer] = skip_value
In case you want to try the algorithm out for yourself, heres a link to the repo. https://github.com/cleor41/StackOverflow_AlignArrays.
I don't know an ounce of Delphi but I tried to write it in Delphi so maybe you can understand it better. I also don't understand the need to have the control array.
procedure AlignArraysBackwards(var vLeft, vRight: TArray<TData>);
var
endPointer: Integer;
vBlankRecord: TData;
// Assumes the arrays have at least 1 element
ldPointer: Length(vLeft)-1;
rdPointer: Length(vRight)-1;
maxElement: Max(vLeft[ldPointer].DataID,vRight[rdPointer].DataID);
// Set this to 1 if arrays should always be 1 alligned
// Else it aligns arrays starting from the array with the smallest value.
minElement: Min(vLeft[0].DataID,vRight[0].DataID);
padLength: maxElement - minElement + 1;
begin
// set blank record to blank out the moved line
vBlankRecord.DataID:=0;
vBlankRecord.DataName:='';
vBlankRecord.BlankLine:=True;
// set length for arrays
SetLength(vLeft, padLength);
SetLength(vRight, padLength);
// align - starting from the bottom up
for endPointer := High(vLeft) downto 0 do
begin
// Start Left array
if vLeft[ldPointer].DataID = endPointer + minElement
then
begin
vLeft[endPointer] := vLeft[ldPointer];
ldPointer := ldPointer - 1;
end
else
begin
vLeft[endPointer] := vBlankRecord;
end;
// End Left Array
// Start Right array
if vRight[rdPointer].DataID = endPointer + minElement
then
begin
vRight[endPointer] := vRight[rdPointer];
rdPointer := rdPointer - 1;
end
else
begin
vRight[endPointer] := vBlankRecord;
end;
// End Right Array
end;
end;
You can make a method that will insert the records in the array or (as in my sample) you can use generics (TList).
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Generics.Collections;
type
TData = record
DataID: integer;
DataName: string;
BlankLine: boolean;
// I add this function to make it make the code easier to read
class function New(const DataID: integer; DataName: string;
BlankLine: boolean = false): TData; static;
end;
var
aLeft, aRight: TList<TData>;
{ TData }
class function TData.New(const DataID: integer; DataName: string;
BlankLine: boolean = false): TData;
begin
result.DataID := DataID;
result.DataName := DataName;
result.BlankLine := BlankLine;
end;
procedure AllignData;
var
n: word;
begin
n := 0;
repeat
if (n < aRight.Count) and (n < aLeft.Count) then
begin
if aLeft[n].DataID < aRight[n].DataID then
aRight.Insert(n, TData.New(aLeft[n].DataID, '', true))
else if aLeft[n].DataID > aRight[n].DataID then
aLeft.Insert(n, TData.New(aRight[n].DataID, '', true));
// if they are equlal, we skip the line
// you wish to use an array instead, write a function inserting data item in it
end
else
begin
if n < aLeft.Count then
aRight.Add(TData.New(aRight[n].DataID, '', true));
if n < aRight.Count then
aLeft.Add(TData.New(aRight[n].DataID, '', true));
end;
inc(n);
until (n >= aRight.Count) and (n >= aLeft.Count);
end;
procedure OutputData;
var
n: word;
sl, sr: string;
begin
n := 0;
repeat
if n < aLeft.Count then
sl := aLeft[n].DataName
else
sl := '';
if n < aRight.Count then
sr := aRight[n].DataName
else
sr := '';
writeln(sl: 15, sr: 15);
inc(n);
until (n >= aRight.Count) and (n >= aLeft.Count);
end;
begin
// Initialize the data
aLeft := TList<TData>.Create;
aRight := TList<TData>.Create;
try
aLeft.Add(TData.New(1, 'One'));
aLeft.Add(TData.New(3, 'Three'));
aLeft.Add(TData.New(6, 'Six'));
aLeft.Add(TData.New(8, 'Eight'));
aRight.Add(TData.New(1, 'One'));
aRight.Add(TData.New(2, 'Two'));
aRight.Add(TData.New(4, 'Four'));
aRight.Add(TData.New(5, 'Five'));
aRight.Add(TData.New(7, 'Seven'));
aRight.Add(TData.New(8, 'Eight'));
aRight.Add(TData.New(9, 'Nine'));
aRight.Add(TData.New(10, 'Ten'));
// Do the output and processing
OutputData;
// I assume that the arrays (lists) have been sorted
AllignData;
writeln;
OutputData
finally
aLeft.Free;
aRight.Free;
end;
readln;
end.

Local string array initialization

I have sporadic problems (access violation in unit System).
Application is running 24 x 7 and it happens one - two times in a week.
I have a procedure with local string array, and I found there are cases I assign non initialised array member to string variable like in code below.
Could it be a reason for access violation?
procedure tform1.DoSomething;
var
sarr: array [1..4] of String;
s: String;
begin
sarr[1] := 'aaaa';
sarr[2] := 'bbbb';
s := sarr[3]; // Can I get here an access violation???
end;
Real function code below
exception happens when obj.opcode = cmdp_done
function is called from thread message queue. obj is created in another thread, and
sent in PostThreadMessage as msg.lparam
procedure ORTR_ProcessFiscalResponse(obj: TDataForOrpak);
const
maxdim = 4;
var
s: array [1..maxdim] of String;
i, n, fiscalNr, statusToSend: Integer;
sql, pdf, ortrName, docType, rut: String;
ortr: TCustomizedOrtr;
oFiscal: TFiscalDevice;
fpds: TFPDeviceState;
begin
try
case obj.opcode of
cmdp_status: N := 3;
cmdp_done: N := 2;
plcl_docissued: N := 4;
plcl_docfailed: N := 1;
else
Exit;
end;
for i:=1 to n do
s[i] := GetTerm(obj.ident, i, ';');
if s[1] = '' then
Exit;
statusToSend := 0;
ortrName := GetTerm(s[1], 1, '+');
fiscalNr := StrToIntDef(GetTerm(s[1]+'+', 2, '+'), 999999);
docType := s[3];
rut := s[4];
ortr := TCustomizedOrtr.GetTerminalByName(ortrName) as TCustomizedOrtr;
if ortr = nil then
Exit;
if (ortr.FPState = fps_idle) or (ortr.fiscalNr <> fiscalNr) then begin
if (StrToIntDef(s[2], 0) <> 0) and (obj.opcode = cmdp_done) then
fiscal_Confirm(obj.otherdevname, obj.ident);
if obj.opcode = plcl_docissued then begin
try
PLCL_SetDocState(s[1], rut, false, StrToInt(s[2]), StrToInt(docType));
except
AddToLogFile('*** PLCL_SetDocState', log_exceptions);
end;
end;
Exit;
end;
oFiscal := fiscal_Assigned(ortr.ctlPump.PumpID) as TFiscalDevice;
case obj.opcode of
plcl_docissued:
begin
ortr.authData.ECRReceiptNr := s[2];
pdf := StringFromHexPresentation(obj.rawdata);
sql := format(sql_PaperlessAdd, [
ToLocalSQL_DateTime(ortr.ctlPump.FinalTime),
ToLocalSQL_Integer(ortr.ctlPump.PumpID),
ToLocalSQL_String(pdf)]);
try
UpdateLocalDB(sql);
except
AddToLogFile('*** PL save pdf', log_exceptions);
end;
try
PLCL_SetDocState(s[1], rut, true, StrToInt(s[2]), StrToInt(docType));
except
AddToLogFile('*** PLCL_SetDocState', log_exceptions);
end;
ortr.FPState := fps_idle;
ortr.currStage := TTextIndexType(0);
ortr.currStage := tivirt_towelcome; // VADIM
ExternalProcessPumpState(ortr.authData.gsPump.PumpID);
end;
plcl_docfailed:
ortr.FPState := fps_plerror;
cmdp_status:
begin
ortr.FPError := StrToIntDef(s[3], 0);
fpds := TFPDeviceState(StrToIntDef(s[2], 0));
ortr.FPState := fpds;
if (fpds in [fps_nocomm, fps_error]) and (ortr.fiscalMode = 1) and
(ortr.authData = nil) and (ortr.fiscalNr < 0) then
SpecialInterface.SendFiscalNrToPromax(-ortr.fiscalNr, '0');
case fpds of
fps_nopaper: statusToSend := wph_prnpaperout;
fps_nocomm: statusToSend := wph_prncommfailure;
fps_error: statusToSend := wph_prngenericfailure;
end;
end;
cmdp_done:
begin
if ortr.fiscalMode = 1 then begin
if ortr.authData = nil then begin // DRY GOOD
SpecialInterface.SendFiscalNrToPromax(-fiscalNr, s[2]);
end
else begin
ortr.authData.ECRReceiptNr := s[2];
ExternalProcessPumpState(ortr.authData.gsPump.PumpID);
end
end;
if StrToIntDef(s[2], 0) <> 0 then
fiscal_Confirm(obj.otherdevname, obj.ident);
statusToSend := wph_prnidle;
ortr.FPState := fps_idle;
ortr.currStage := ti_takereceipt;
end;
end;
if (statusToSend <> 0) and (oFiscal <> nil) then
PostNonVisualCommand(nv_devicestate, statusToSend, Integer(oFiscal));
finally
obj.free;
end;
end;
Your initial piece of code, the tform1.DoSomething routine, is unable of producing an access violation:
For the static array variable sarr, memory is allocated for all its elements.
The string variable s, as well as the elements in sarr, are automatically initialized to empty. 1
Thus you are simply assigning an empty string, and s remains empty.
Concerning your actual code, assuming that it does produce the access violation, my guess would be that:
the obj parameter still refers to an already destroyed object,
that obj.opcode reads an invalid piece of memory, but since it is compared to an numerical value, will pass,
that Exit is called in de case else clause, and
that obj.Free fails in the finally clause.
1 All string variables are initilized to empty, except string function results:
If the function exits without assigning a value to Result or the function name, then the function's return value is undefined.
The missing compiler warning is still a bug.

Resources