Invalid Pointer Operation on TObjectList.DisposeOf - oop

Hello folks and sorry if this is a duplicate but my specific issue I haven't seen answered anywhere yet.
I have an "Invalid Pointer Operation" when I try to free an ObjectList created at runtime at the following lines:
Prods := TItemProcedimento.Create(DM.FDQ).lerProdutos;
Prods.DisposeOf; // <- Invalid Pointer Operation at 2nd iteration
So, here's my classes:
unit uItemProcedimento;
interface
[...]
type
TItemProcedimento = class
[...]
public
constructor Create(DataSet: TFDQuery);
function lerProdutos: TObjectList<TItemProcedimento>;
[...]
constructor TItemProcedimento.Create(DataSet: TFDQuery);
begin
FDataSet := DataSet;
end;
function TItemProcedimento.lerProdutos: TObjectList<TItemProcedimento>;
begin
Result := TObjectList<TItemProcedimento>.Create;
try
FDataSet.Close;
FDataSet.SQL.Clear;
FDataSet.SQL.Add('SELECT *');
FDataSet.SQL.Add('FROM Produto p');
FDataSet.SQL.Add('JOIN ItensProcedimento IP on p.PRO_ID = IP.PRO_ID');
FDataSet.SQL.Add('ORDER BY p.PRO_Nome');
FDataSet.Open;
while not FDataSet.Eof do
begin
PRO_ID := FDataSet.FieldByName('PRO_ID').AsInteger;
PRO_Rendimento := FDataSet.FieldByName('PRO_Rendimento').AsInteger;
PRO_Nome := FDataSet.FieldByName('PRO_Nome').AsString;
PRO_Tipo := FDataSet.FieldByName('PRO_Tipo').AsInteger;
PRO_Custo := FDataSet.FieldByName('PRO_Custo').AsFloat;
PRO_Potencia := FDataSet.FieldByName('PRO_Potencia').AsFloat;
IPR_Uso := FDataSet.FieldByName('IPR_Uso').AsFloat;
Result.Add(self);
FDataSet.Next;
end;
finally
FDataSet.Close;
end;
The weirdest thing about this is that I have another class with the exact same behaviour and the method works without issues. Yes I am creating the object and immediately destroying it to test if I'm destroying it correctly.
In another class I have another example with the same code, but this time it works without errors
test := TMyClass.Create(DM.FDQ).lerTeste;
test.DisposeOf;
Why? What am I doing wrong? This test code is running before the current code btw, maybe its related?
UPDATE:
By applying the changes that Remy Lebeau suggested I managed to add properly the items to the list and dispose them so this particular part of the code has no leaks. But in another part of the code I have an ObjectList leak that I have no idea on how to fix.
Inside my class I have a property that is a TObjectList property, I have a method that checks if the list is assigned, if not, it creates it and returns it to whoever is calling the list.
[...]
type
TProcedimento = class
private
[...]
FPRC_Produtos: TObjectList<TItemProcedimento>;
public
[...]
function getPRC_Produtos: TObjectList<TItemProcedimento>;
function criaProcedimentos: TObjectList<TProcedimento>;
[...]
function TProcedimento.GetPRC_Produtos: TObjectList<TItemProcedimento>;
begin
if not Assigned(FPRC_Produtos) then
FPRC_Produtos:= TObjectList<TItemProcedimento>.Create;
result := FPRC_Produtos;
end;
function TProcedimento.criaProcedimentos: TObjectList<TProcedimento>;
var
IPR: TItemProcedimento;
Procedimento: TProcedimento;
ds: TFDQuery;
begin
result := TObjectList<TProcedimento>.Create;
ds := TFDQuery.Create(nil);
ds.Connection := FDataSet.Connection;
IPR := TItemProcedimento.Create(ds);
try
FDataSet.Close;
FDataSet.Open('SELECT * FROM Procedimento');
while not FDataSet.Eof do
begin
Procedimento := TProcedimento.Create(FDataSet);
Procedimento.PRC_ID := FDataSet.FieldByName('PRC_ID').AsInteger;
Procedimento.PRC_Nome := FDataSet.FieldByName('PRC_Nome').AsString;
Procedimento.PRC_Duracao := FDataSet.FieldByName('PRC_Duracao')
.AsDateTime;
Procedimento.PRC_Preco := FDataSet.FieldByName('PRC_Preco').AsCurrency;
Procedimento.PRC_Custo := FDataSet.FieldByName('PRC_Custo').AsCurrency;
Procedimento.PRC_Consumo := FDataSet.FieldByName('PRC_Consumo').AsFloat;
Procedimento.FPRC_Produtos := IPR.getItensProcedimento(FPRC_ID);
result.Add(Procedimento);
FDataSet.Next;
end;
finally
FDataSet.Close;
IPR.DisposeOf;
ds.DisposeOf;
end;
end;
I then use this property in a for-in loop to feed a list with the procs in my database
procedure TKBForm1.CarregaProcedimento;
var
Procedimento: TProcedimento;
Procs: TObjectList<TProcedimento>;
[...]
begin
Procs := TProcedimento.Create(DM.FDQ).criaProcedimentos;
try
LV_Procedimento.Items.Clear;
LV_Procedimento.BeginUpdate;
for Procedimento in Procs do
begin
with LV_Procedimento.Items.Add do
[...]
finally
Procs.DisposeOf;
Procedimento.GetPRC_Produtos.DisposeOf;
end;
end;
But there's still leaks happening after this part runs:
73 - 88 bytes: TProcedimento x 1, TItemProcedimento x 2
How do I fix this?

Related

Delphi Syntax error in FROM clause, but no from clause

I'm really new to Delphi and have not yet worked with SQL (I'm a complete beginner).
I use code to connect my database and tables to my program, but as soon as I run my program, I get a Syntax error in FROM clause message.
When I select break, it highlights end; of a part of the code.
function TADOCommand.Execute(var RecordsAffected: Integer;
const Parameters: OleVariant): _Recordset;
var
VarRecsAffected: OleVariant;
begin
SetConnectionFlag(cfExecute, True);
try
Initialize;
Result := CommandObject.Execute(VarRecsAffected, Parameters,
Integer(CommandObject.CommandType) + ExecuteOptionsToOrd
(FExecuteOptions));
RecordsAffected := VarRecsAffected;
finally
SetConnectionFlag(cfExecute, False);
end;
end;
I have three tables, of which two display on their grids, but one is not displaying on the grid, and also gives me the Syntax error in FROM clause when I want to do anything with it.
This is the code that I used to connect my database in the datamodule:
unit dmChamps_u;
interface
uses
System.SysUtils, System.Classes, ADODB, DB; // add Ado and DB
type
TdmChamps = class(TDataModule)
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
conArchers: TADOConnection;
tblArchers: TADOTable;
tblJT: TADOTable;
tblMatches: TADOTable;
dscArchers: TDataSource;
dscMatches: TDataSource;
dscJT: TDataSource;
end;
var
dmChamps: TdmChamps;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TdmChamps.DataModuleCreate(Sender: TObject);
begin
// create objects
conArchers := TADOConnection.Create(dmChamps);
tblArchers := TADOTable.Create(dmChamps);
tblMatches := TADOTable.Create(dmChamps);
tblJT := TADOTable.Create(dmChamps);
dscArchers := TDataSource.Create(dmChamps);
dscMatches := TDataSource.Create(dmChamps);
dscJT := TDataSource.Create(dmChamps);
// setup connection
conArchers.ConnectionString :=
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=ArchChampsDB.mdb;Mode=ReadWrite;Persist Security Info=False';
conArchers.LoginPrompt := false;
conArchers.Open;
// setup table archers
tblArchers.Connection := conArchers;
tblArchers.TableName := 'Archers';
// setup data source
dscArchers.DataSet := tblArchers;
tblArchers.Open;
// setup table matches
tblMatches.Connection := conArchers;
tblMatches.TableName := 'Matches';
// setup data source
dscMatches.DataSet := tblMatches;
tblMatches.Open;
// setup table JT
tblJT.Connection := conArchers;
tblJT.TableName := 'Judges/Timekeepers';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
end;
end.
I've looked through all of the questions on the From clause error already on the site, but none of the scenarios quite match my problem. I also went to Embarcadero's site and read about TableDirect, which I thought might be a possible solution, but it was already in the code.
Your error is here
tblJT.TableName := 'Judges/Judges';
You can't has a table with that name, or Judges or Timekeepers
You can solve do it:
// setup table J
tblJT.Connection := conArchers;
tblJT.TableName := 'Judges';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
Separated
// setup table T
tblJT.Connection := conArchers;
tblJT.TableName := 'Timekeepers';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
Maybe it is because of the slash in 'Judges/Timekeepers'.
Did you try to debug step by step going to the code in DataModuleCreate?

Object within another Object not persisting between units Delphi

Sorry if this question is a duplicate but I couldn't find any solution to my problem anywhere...
The code below shows how I'm assigning values from a listview into an object that is a property of another object:
Main Unit:
procedure TForm1.SBCadClick(Sender: TObject);
var
Procedimento: TProcedimento;
Produto: TItemProcedimento;
item: TListViewItem;
begin
...
Procedimento := TProcedimento.Create;
for item in LVItensProcedimento.Items do
begin
Produto := TItemProcedimento.Create;
Produto.PRO_ID := item.Tag;
Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso'))
.Text.ToDouble;
Procedimento.AddPRC_Produtos(Produto);
Produto.DisposeOf;
end;
DM.gravaProcedimento(Procedimento); // from here we go into another unit to use its function, passing an object as a parameter
Before the command DM.gravaProcedimento(Procedimento); the produto is correctly being added to the TObjectList of TProcedimento, I can get its contents correctly with Procedimento.GetPRC_Produtos. But when I debug the next unit shown below, its getting random IDs that means its not being persisted from one unit to the other:
unit DM:
procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
produto: TItemProcedimento;
dura: string;
begin
...
produto := TItemProcedimento.Create;
for produto in Procedimento.GetPRC_Produtos do
begin
DM.FDQ.Append;
DM.FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID; // here the value gets a random ID like 45684 instead of the current item ID
DM.FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
DM.FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
DM.FDQ.Post;
end;
produto.DisposeOf;
DM.FDQ.ApplyUpdates;
DM.FDQ.Close;
end;
This is the class definition of my objects:
unit uClasses;
interface
uses
System.SysUtils, System.Types, Generics.Collections;
type
TItemProcedimento = class
private
FPRO_Nome: string;
FPRO_Tipo: integer;
FPRO_Custo: double;
FPRO_ID: integer;
FPRO_Rendimento: integer;
FPRO_Potencia: double;
FIPR_Uso: double;
procedure SetPRO_Custo(const Value: double);
procedure SetPRO_ID(const Value: integer);
procedure SetPRO_Nome(const Value: string);
procedure SetPRO_Rendimento(const Value: integer);
procedure SetPRO_Tipo(const Value: integer);
procedure SetPRO_Potencia(const Value: double);
procedure SetIPR_Uso(const Value: double);
public
constructor Create;
published
property PRO_Rendimento: integer read FPRO_Rendimento
write SetPRO_Rendimento;
property PRO_ID: integer read FPRO_ID write SetPRO_ID;
property PRO_Nome: string read FPRO_Nome write SetPRO_Nome;
property PRO_Tipo: integer read FPRO_Tipo write SetPRO_Tipo;
property PRO_Custo: double read FPRO_Custo write SetPRO_Custo;
property PRO_Potencia: double read FPRO_Potencia write SetPRO_Potencia;
property IPR_Uso: double read FIPR_Uso write SetIPR_Uso;
end;
TProcedimento = class
private
FPRC_Nome: string;
FPRC_Duracao: TDateTime;
FPRC_Preco: double;
FPRC_ID: integer;
FPRC_Consumo: double;
FPRC_Produtos: TObjectList<TItemProcedimento>;
procedure SetPRC_Consumo(const Value: double);
procedure SetPRC_Duracao(const Value: TDateTime);
procedure SetPRC_ID(const Value: integer);
procedure SetPRC_Nome(const Value: string);
procedure SetPRC_Preco(const Value: double);
public
constructor Create;
function GetPRC_Produtos: TObjectList<TItemProcedimento>;
procedure AddPRC_Produtos(const Value: TItemProcedimento);
procedure DelPRC_Produtos(const Value: TItemProcedimento);
procedure CleanPRC_Produtos;
published
property PRC_Preco: double read FPRC_Preco write SetPRC_Preco;
property PRC_Consumo: double read FPRC_Consumo write SetPRC_Consumo;
property PRC_ID: integer read FPRC_ID write SetPRC_ID;
property PRC_Nome: string read FPRC_Nome write SetPRC_Nome;
property PRC_Duracao: TDateTime read FPRC_Duracao write SetPRC_Duracao;
end;
implementation
{ TProcedimento }
procedure TProcedimento.CleanPRC_Produtos;
begin
if not Assigned(FPRC_Produtos) then
FPRC_Produtos := TObjectList<TItemProcedimento>.Create
else
FPRC_Produtos.Clear;
end;
constructor TProcedimento.Create;
begin
SetPRC_Consumo(0);
SetPRC_Duracao(0);
SetPRC_ID(0);
SetPRC_Nome('');
SetPRC_Preco(0);
end;
procedure TProcedimento.DelPRC_Produtos(const Value: TItemProcedimento);
begin
FPRC_Produtos.Delete(FPRC_Produtos.IndexOf(Value));
end;
function TProcedimento.GetPRC_Produtos: TObjectList<TItemProcedimento>;
begin
if Assigned(FPRC_Produtos) then
result := FPRC_Produtos
else
begin
CleanPRC_Produtos;
result := FPRC_Produtos;
end;
end;
procedure TProcedimento.SetPRC_Consumo(const Value: double);
begin
FPRC_Consumo := Value;
end;
procedure TProcedimento.SetPRC_Duracao(const Value: TDateTime);
begin
FPRC_Duracao := Value;
end;
procedure TProcedimento.SetPRC_ID(const Value: integer);
begin
FPRC_ID := Value;
end;
procedure TProcedimento.SetPRC_Nome(const Value: string);
begin
FPRC_Nome := Value;
end;
procedure TProcedimento.SetPRC_Preco(const Value: double);
begin
FPRC_Preco := Value;
end;
procedure TProcedimento.AddPRC_Produtos(const Value: TItemProcedimento);
begin
FPRC_Produtos.Add(Value);
end;
{ TItemProcedimento }
constructor TItemProcedimento.Create;
begin
SetPRO_Custo(0);
SetPRO_ID(0);
SetPRO_Nome('');
SetPRO_Tipo(0);
SetPRO_Rendimento(0);
end;
procedure TItemProcedimento.SetIPR_Uso(const Value: double);
begin
FIPR_Uso := Value;
end;
procedure TItemProcedimento.SetPRO_Custo(const Value: double);
begin
FPRO_Custo := Value;
end;
procedure TItemProcedimento.SetPRO_ID(const Value: integer);
begin
FPRO_ID := Value;
end;
procedure TItemProcedimento.SetPRO_Nome(const Value: string);
begin
FPRO_Nome := Value;
end;
procedure TItemProcedimento.SetPRO_Potencia(const Value: double);
begin
FPRO_Potencia := Value;
end;
procedure TItemProcedimento.SetPRO_Rendimento(const Value: integer);
begin
FPRO_Rendimento := Value;
end;
procedure TItemProcedimento.SetPRO_Tipo(const Value: integer);
begin
FPRO_Tipo := Value;
end;
end.
Any particular reason why this is happening? What am I doing wrong here?
The problem is that you are destroying the TItemProcedimento objects before gravaProcedimento() has a chance to use them.
You are calling Produto.DisposeOf() immediately after Procedimento.AddPRC_Produtos(Produto) exits, and also in gravaProcedimento(), too. DO NOT DO THAT!
AddPRC_Produtos() saves the original Produto object into a TObjectList, which takes ownership of the object (as TObjectList is set to OwnsObjects=True by default). That means the object will be destroyed automatically when it is removed from the list, which includes when the list is cleared or destroyed.
So, you need to get rid of your DisposeOf() calls completely.
Also, you need to get rid of the call to TItemProcedimento.Create in gravaProcedimento(), too. It does not belong there. All you are doing by that is creating a memory leak on non-ARC systems.
It seems you do not have a firm grasp of how Delphi object lifetimes actually work. You DO NOT need to call Create on an object variable before assigning an object instance to it. And you DO NOT need to call DisposeOf() on an object variable when you are doing using the variable, only when you are done using the object itself (which TObjectList will handle for you).
Try this instead:
procedure TForm1.SBCadClick(Sender: TObject);
var
Procedimento: TProcedimento;
Produto: TItemProcedimento;
item: TListViewItem;
begin
...
Procedimento := TProcedimento.Create;
try
for item in LVItensProcedimento.Items do
begin
Produto := TItemProcedimento.Create;
try
Produto.PRO_ID := item.Tag;
Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso')).Text.ToDouble;
Procedimento.AddPRC_Produtos(Produto);
// Produto.DisposeOf; // <-- DO NOT DO THIS HERE!!!
except
Produto.DisposeOf; // <-- DO THIS HERE INSTEAD, if AddPRC_Produtos fails!!!
raise;
end;
end;
DM.gravaProcedimento(Procedimento);
finally
Procedimento.DisposeOf; // <-- ADD THIS, if needed!!!
end;
end;
procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
produto: TItemProcedimento;
dura: string;
begin
...
// produto := TItemProcedimento.Create; // <- DO NOT DO THIS!!!
for produto in Procedimento.GetPRC_Produtos do
begin
FDQ.Append;
try
FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID;
FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
FDQ.Post;
except
FDQ.Cancel; // <-- ADD THIS!!!
raise;
end;
end;
// produto.DisposeOf; // <-- DO NOT DO THIS!!!
FDQ.ApplyUpdates;
FDQ.Close;
end;
You should not call Produto.DisposeOf in procedure TForm1.SBCadClick.
You are destroying the object you have just added..

How to Sort Sections on TMemIniFile

I am using TMemIniFile to store configuration and I need to sort the sections in alpha order.
For that I have created a descendant of TMemIniFile
TRWStudioMemIniFile = class(TMemIniFile)
public
procedure UpdateFile; override;
procedure GetSortedStrings(List: TStrings);
end;
{ TRWStudioMemIniFile }
procedure TRWStudioMemIniFile.GetSortedStrings(List: TStrings);
var
I, J: Integer;
Strings: TStrings;
begin
List.BeginUpdate;
try
Sections.Sort;
for I := 0 to Sections.Count - 1 do
begin
List.Add('[' + Sections[I] + ']');
Strings := TStrings(Sections.Objects[I]);
for J := 0 to Strings.Count - 1 do List.Add(Strings[J]);
List.Add('');
end;
finally
List.EndUpdate;
end;
end;
procedure TRWStudioMemIniFile.UpdateFile;
var
List: TStringList;
begin
List := TStringList.Create;
try
GetSortedStrings(List);
List.SaveToFile(FileName, Encoding);
finally
List.Free;
end;
end;
but it needs to have access to the Sections (actually FSections: TStringList, that is a private member of TMemIniFile)
I have created a Helper class to expose that member thru a property. However this behavior is not supported anymore in Delphi 10.1
I started copy/paste the TMemIniFile to my unit and after and endless process I am ending up making a copy of the entire System.IniFile, just to access the FSections.
My question is how to access that FSections member without need to duplicate everything from that unit just to gain visibility
OR is there another way that I can Sort the Sections before saving? (I am just calling the TStringList.Sort from FSections)
Rather than relying on type-casting and "cracking open" the private member, you can instead get the sections into your own TStringList using the inherited ReadSections() method, sort that list as needed, and then use the inherited ReadSectionValues() method to read the strings for each section:
var
sections: TStringList;
values: TStringList;
begin
sections := TStringList.Create;
try
ReadSections(sections);
sections.Sort;
values := TStringList.Create;
try
List.BeginUpdate;
try
for I := 0 to sections.Count - 1 do
begin
List.Add('[' + sections[I] + ']');
values.Clear; // Just in case
ReadSectionValues(sections[i], values);
for J := 0 to values.Count - 1 do
List.Add(values[J]);
List.Add('');
end;
finally
List.EndUpdate;
end;
finally
values.Free;
end;
finally
sections.Free;
end;
end;

Using Firedac to run SQL stored procedure

I'm trying to figure out how to run a stored procedure using firedac
unit DataLayer.OilCommanderConnection;
interface
uses
FireDAC.Phys.FB,
Generics.Collections,
Model.Sample,
Model.Batch,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error,
FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL, Data.DB,
FireDAC.Comp.Client, FireDAC.Phys.MSSQL,
FireDAC.DApt,
FireDAC.Comp.UI
;
type
TOilCommanderConnection = class
strict private
public
Connection : TFDConnection;
function GetSampleTypesForBatch(Batch : TBatch) : Boolean;
function Connect:Boolean;
constructor Create;
destructor Destroy; override;
end;
implementation
uses
SysUtils
;
function TOilCommanderConnection.Connect:Boolean;
var
OK : Boolean;
begin
OK := true;
Connection := TFDConnection.Create(nil);
try
Connection.Params.LoadFromFile('MSSQL.ini');
finally
Result := OK;
end;
end;
function TOilCommanderConnection.GetSampleTypesForBatch(Batch : TBatch) : Boolean;
var
StoredProc : TFDStoredProc;
begin
Connect;
StoredProc := TFDStoredProc.Create(nil);
try
StoredProc.Connection := Connection;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items - [fiMeta];
with StoredProc.Params do
begin
Clear;
with Add do
begin
Name := 'BatchNo';
ParamType := ptInput;
DataType := ftString;
Size := 6;
end;
end;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.Params[0].Value := Batch.RackNo;
StoredProc.ExecProc;
while not StoredProc.Eof do
begin
//StoredProc.FieldByName('').AsS
StoredProc.Next;
end;
finally
FreeAndNil(StoredProc);
end;
Result := true;
end;
constructor TOilCommanderConnection.Create;
begin
inherited;
Connection := TFDConnection.Create(nil);
end;
destructor TOilCommanderConnection.Destroy;
begin
if Assigned(Connection) then FreeAndNil(Connection);
inherited;
end;
end.
I get an error message a the first occurrence of the line
StoredProc.Prepare;
Here is the message
--------------------------- Debugger Exception Notification
Project RefractiveIndexTests.exe raised exception class Exception with message 'Object factory for class
{3E9B315B-F456-4175-A864-B2573C4A2201} is missing. To register it, you
can drop component [TFDGUIxWaitCursor] into your project'.
I've called the function using
OilCommanderConnection.GetSampleTypesForBatch(batch);
from a test project.
the tutorial I read didn't explain what to do about this situation.
I've tried adding TFDGUIxWaitCursor into my project as the error message suggests but this has not made any difference. I wonder if this problem is related to me keeping the Database connection logic in a separate unit to my Main Form. I would like to be able to separate my user interface from my Data Layer.
Depending on the type of your application, include one of the following units into any one "uses" clause:
FireDAC.VCLUI.Wait - for VCL applications;
FireDAC.FMXUI.Wait - for FireMonkey applications;
FireDAC.ConsoleUI.Wait - for console / non-visual applications.

How do I send POST data using TW3HttpRequest

So I've started playing with SMS and I've tried to make a program (label and button) to hit a website with a post request and display the result.
I have no problems with Hints/Warnings/Errors and everything looks good to me. The following code is a rework of a couple of existing examples mashed together.
procedure TForm1.ExecuteCmd;
var
whttp : TW3HttpRequest;
wParams : string;
begin
wHttp := TW3HttpRequest.Create;
try
whttp.OnDataReady := lambda (Sender)
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
whttp.OnReadyStateChange := lambda (Sender)
if (wHttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://www.server1.com/executecmd.php');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
finally
wHttp.free;
end;
end;
procedure TForm1.W3Button1Click(Sender: TObject);
begin
ExecuteCmd;
end;
The problem is this, when I actually click the button I get the following error message:
Uncaught TypeError: Cannot read property 'readyState' of null [line #6277]
The error is in the auto generated code and seems to have no relation to what I've written specifically. If I take out all references to ReadyState from my code I still get the error.
What am I missing? I feel like it has something to do with the Lambda functions.
Your problem is that you are expecting whttp.Send to block. Send, as its JavaScript equivalent, is asynchronous. Before the POST could even execute, whttp object is freed (in the finally block). When callback (OnReadyStateChanged) is called, whttp was already freed (and is now null) and you are then trying to call ReadyState on that freed (null) object.
Another reason for confusion is that object.Free in Delphi for Windows/OS X destroys the object while in Smart it merely sets the object reference to nil and leaves the destruction to JavaScript's garbage collection. That's why the whttp is still alive after the Free and why the OnReadyStateChanged is called at all.
This works fine:
uses
W3System, W3Graphics, W3Components, W3Forms, W3Fonts, W3Borders, W3Application,
W3Button, W3Inet, W3Memo;
type
TForm1=class(TW3form)
procedure W3Button1Click(Sender: TObject);
private
{$I 'Form1:intf'}
whttp: TW3HttpRequest;
protected
procedure InitializeForm; override;
procedure InitializeObject; override;
procedure Resize; override;
end;
implementation
{ TForm1}
procedure TForm1.W3Button1Click(Sender: TObject);
var
wParams: string;
begin
whttp := TW3HttpRequest.Create;
whttp.OnReadyStateChange := lambda (Sender)
if (whttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
W3Memo1.Text := wHttp.ResponseText;
whttp.OnReadyStateChange := nil;
whttp := nil;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://httpbin.org/post');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
end;