Initiating a SOAP Array on Delphi - arrays

I am trying to initialize or create an array of a soap call:
Array_Of_ProductIdentifierClinicalType = array of ProductIdentifierClinicalType;
This is the way that I am trying to initialize it:
Product[0].IdentifierType := Array_Of_ProductIdentifierClinicalType.Create();
When I run the application I get this error: Access Violation at address...
The question would be: How to initialize this soap call??
Thank you for your time!!!!
You can do a WSDL import on: http://axelcarreras.dyndns.biz:3434/WSAlchemy.wsdl
procedure TFrmMain.Button16Click(Sender: TObject);
Var
ExcludeExpiradas: String;
Serv: AlchemyServiceSoap;
req: AlchemyClinical;
element: AlchemyClinicalRequest;
Prescribed: PrescribedType;
//Prescribing: Prescribing
Prescribing: PrescribedType;
alc: AlchemyIdentifierType;
D: TXSDate;
Counter: Integer;
ProductStr: AlchemyIdentifierClinicalType;
begin
With DM do
begin
ExcludeExpiradas := ' and (' + chr(39) + DateToStr(Date) + chr(39) + ' < (FECHARECETA + 180)) ';
CDSRx_Procesadas.Close;
CDSRx_Procesadas.CommandText := 'SELECT * ' +
' FROM RX_PROCESADAS WHERE ' +
' (NUMERORECETA IS NOT NULL AND CANTIDAD_DISPONIBLE > 0)' +
ExcludeExpiradas +
' and NumeroCliente = ' + CDSPacientesNumeroCliente.asString +
' Order by NumeroReceta';
//ShowMessage(CDSRx_Procesadas.CommandText);
CDSRx_Procesadas.Open;
ProductStr := AlchemyIdentifierClinicalType.Create;
With ProductStr do
begin
Identifier := 1;
end;
element := AlchemyClinicalRequest.Create;
//Prescribed := PrescribedType.Create;
With element do
begin
With Prescribed do
begin
Counter := 0;
while not CDSRx_Procesadas.eof do
begin
Product := Array_Of_ProductIdentifierClinicalType.Create();
With Product[0] do
begin
IdentifierType := ProductIdentifierTypeEnum.NDC9;
Identifier := Copy(DM.CDSInventarioNDC.Value, 1, 9);
end;
Counter := Counter + 1;
CDSRx_Procesadas.Next;
end;
end;
With Prescribing do
begin
Counter := 0;
Product[0].IdentifierType := ProductIdentifierTypeEnum.AlchemyProductID;
Product[0].Identifier := Copy(DM.CDSInventarioNDC.Value, 1, 9);
Counter := Counter + 1;
end;
With PatientDemographics do
begin
while not CDSAlergies.Eof do
begin
Allergy.AllergySubstanceClass[0].Identifier := CDSAlergiesNOALERGIA.Value;
CDSAlergies.Next;
end;
if CDSPacientesSEXO.Value = 1 then
Gender := GenderTypeEnum.Male
else
Gender := GenderTypeEnum.Female;
D := TXSDate.Create;
D.AsDate := CDSPacientesFECHANACIMIENTO.AsDateTime;
DateOfBirth := D;
end;
With RequestedOperations do
begin
DrugToDrug := True;
//DuplicateTherapy
Allergy := True;
With WarningLabels do
begin
Request := True;
LanguageCode := 'en-US';
MaxLines := 5;
CharsPerLine := 24;
end;
With DoseScreening do
begin
Request := True;
end;
AdverseReactions.Request := True;
end;
IgnorePrescribed := False;
IncludeConsumerNotes := True;
IncludeProfessionalNotes := True;
end;
end;
end;*

Assuming that this line of code from the question is accurate:
Array_Of_ProductIdentifierClinicalType = array of ProductIdentifierClinicalType;
then the problem lies here:
Product := Array_Of_ProductIdentifierClinicalType.Create();
This is a dynamic array constructor. It creates a dynamic array of length equal to the number of parameters to the constructor. And then assigns each element of the array, in turn, to the parameters passed.
Consider an example using TBytes = array of Byte.
Bytes := TBytes.Create(1, 2, 3);
This initialises Bytes to be an array of length 3 and having values 1, 2 and 3.
Now, let's look at your code again. This initialises Product to be an array of length 0. So when you access Product[0] that results in a runtime error because the array index is out of bounds.
To solve the problem you will need to make sure that the array is initialised to have sufficient elements. One option is certainly to use a dynamic array constructor. Another is to use SetLength. I suspect that your understanding of Delphi's dynamic arrays is poor. I suggest that you consult the documentation.

Related

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

Delphi - reading the records of a database into a string grid

So how do you write the records of a database (from a TADOTable component) into a String grid? (the record's fields are all strings)
I tried something like this but to no avail:
procedure TfrmPuntehou.WriteToList(tbl: TADOTable;grid:TStringGrid);
var
iNewRowCount:integer;
i,j,m: Integer;
const
separator = ',';
begin
tempList:= TStringList.Create;
try
tbl.First;
while not (tbl.Eof) do
begin
tempList.Add(tbl['Car Number']+separator+tbl['Racer Name']+separator+tbl['Licence']);
tbl.Next;
end;
for j:= 1 to (tempList.Count - 1) do
begin
grid.Rows[j].Text := tempList.Strings[(J-1)] ;
end;
finally
tempList.Free;
end;
//fill the row numbers
for m := 1 to grid.rowcount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
end;
Example of the output I'm trying to get on startup: (Row number column is not part of the db)
Thanks in advance for the help!
Kind Regards
PrimeBeat
You're going through far too much work. You don't need the separate stringlist at all, and your code could be much simpler.
var
i, Row: Integer;
begin
// Populate header row
Grid.Cells[0, 0] := 'Row';
Row := 0;
for i := 0 to Tbl.FieldCount - 1 do
Grid.Cells[i + 1, Row] := Tbl.Fields[i].FieldName; // The +1 skips the Row column
Inc(Row);
// Populate cells
Tbl.First;
while not Tbl.Eof do
begin
for i := 0 to Tbl.FieldCount - 1 do
begin
Grid.Cells[i, Row] := IntToStr(i); // Populate Row number
Grid.Cells[i + 1, Row] := Tbl.Fields[i].AsString; // Fill rest of row with table data
end;
Inc(Row);
Tbl.Next;
end;
end;
Here is an example using TADOQuery and a StringGrid:
procedure TForm1.Button1Click(Sender: TObject);
var
I : Integer;
ARow : Integer;
begin
ADOConnection1.Open('user', 'pass');
ADOQuery1.SQL.Text := 'SELECT * FROM dbo.Person';
ADOQuery1.Open;
if ADOQuery1.Eof then begin
ShowMessage('Data not found');
Exit;
end;
SGrid.RowCount := 1;
SGrid.ColCount := ADOQuery1.Fields.Count + 1;
// Create titles of row 0
for I := 0 to ADOQuery1.Fields.Count - 1 do
SGrid.Cells[I + 1, 0] := ADOQuery1.Fields[I].DisplayName;
// Populate the cells with data from result set
ARow := 1;
while not ADOQuery1.Eof do begin
Inc(ARow);
SGrid.RowCount := ARow + 1;
SGrid.Cells[0, ARow] := ARow.ToString;
for I := 0 to ADOQuery1.Fields.Count - 1 do
SGrid.Cells[I + 1, ARow] := ADOQuery1.Fields[I].AsString;
ADOQuery1.Next;
end;
end;
Thanks to Ken White's answer, I managed to solve the problem!
procedure TfrmPuntehou.WriteToList(tbl: TADOTable;grid:TStringGrid);
var
Row: Integer;
begin
tbl.Active:=True;
Row := 1;
// Populate cells
Tbl.First;
while not Tbl.Eof do
begin
grid.Cells[0,Row]:= IntToStr(Row);
grid.Cells[1,Row]:= tbl.fields[0].AsString;
grid.Cells[2,Row]:= tbl.fields[1].AsString;
grid.Cells[3,Row]:= tbl.fields[2].AsString;
Inc(Row);
IncreaseRowCount(grid);
Tbl.Next;
end;
tbl.Active:=false;
end;

How to assign values to an array of objects in Delphi

I have an array of TBoek and and a loop that is supposed to assign values to each of the elements of the array. What happens instead is that the array ends up with the exact same values in each index. Perhaps my order of processing is incorrect or I'm incorrectly assigning values to the array, but either way I cannot for the life of me figure it out.
procedure TBoek.MaakArray;
var
i: integer;
sTitel, sOuteur, sISBN, sUitgewer, sPrys, sI: string;
boek: TBoek;
begin
boek := TBoek.Create;
for i := 0 to 9 do
begin
{$REGION 'Parse JSON om eienskappe van boek te kry'}
sI := IntToStr(i);
sTitel := JSONFile.GetValue<string>('items[' + sI + '].volumeInfo.title');
try
sOuteur := JSONFile.GetValue<string>
('items[' + sI + '].volumeInfo.authors[0]');
except
sOuteur := '<none>'
end;
try
sISBN := JSONFile.GetValue<string>
('items[' + sI + '].volumeInfo.industryIdentifiers[1].identifier');
except
sISBN := '<none>'
end;
try
sUitgewer := JSONFile.GetValue<string>
('items[' + sI + '].volumeInfo.publisher');
except
sUitgewer := '<none>'
end;
try
sPrys := JSONFile.GetValue<string>
('items[' + sI + '].saleInfo.listPrice.amount');
except
sPrys := '0';
end;
{$ENDREGION}
arrBoeke[i] := boek;
with arrBoeke[i] do
begin
SetTitel(sTitel);
SetOuteur(sOuteur);
SetISBN(sISBN);
SetUitgewer(sUitgewer);
SetPrys(sPrys);
end;
end;///end of for loop
end;
The Set functions all follow this format:
procedure TBoek.SetTitel(BoekTitel: string);
begin
fTitel := BoekTitel;
end;
This is the GetString function:
function TBoek.GetString: string;
begin
Result := GetTitel + #13#10 + GetOuteur + #13#10 + GetISBN + #13#10 +
GetUitgewer + #13#10 + GetPrys + #13#10 + #13#10;
end;
And the GetTitel,GetOuteur etc. functions all follow the same format:
function TBoek.GetTitel: string;
begin
Result := fTitel;
end;
What I want is to call:
for I := 0 to 9 do
begin
ShowMessage(arrBoeke[i].GetString);
end;
and access the values in the array one at a time, instead each value is the same.

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