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;
Related
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?
I am working on a project and I need to think about emergency situations.
The main issue is, how to check if the database is connected (circle object = red or green)?
BeforeConnect, AfterDisconnect, they have no good answer.
Inside type:
Create Connection:
procedure TForm1.Button1Click(Sender: TObject);
var
s : String;
begin
ADOConnectionSQL := TADOConnection.Create(nil);
ADOConnectionSQL.LoginPrompt := false;
with ADOSQL do
begin
s := 'Provider=SQLNCLI11.1;'+
'Persist Security Info=False;'+
'User ID='+Edit1.Text+';'+
'Initial Catalog='+Edit2.Text+';'+
'Data Source='+Edit3.Text+';'+
'Initial File Name="";'+
'Server SPN="";'+
'password="'+Edit4.Text+'"';
ADOConnectionSQL.ConnectionString := s;
end;
ADOConnectionSQL.BeforeConnect := SQLConnected;
ADOConnectionSQL.AfterDisconnect := SQLDisconnected;
end;
Try to connect:
procedure TForm1.Button2Click(Sender: TObject);
var
Thread : TThread;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
TThread.Synchronize(TThread.CurrentThread,
procedure
begin
try
ADOConnectionSQL.Connected := True;
ADOConnectionSQL.Open;
except
on E: Exception do
begin
ShowMessage('Exception message = '+E.Message);
end;
end;
ADOQuerySQL := TADOQuery.Create(nil);
end);
end);
Thread.OnTerminate := FinishConnected;
Thread.Start;
end;
Green or Red:
procedure TForm1.SQLConnected(Sender: TObject);
begin
Circle1.Fill.Color := $FF00FF00;
end;
procedure TForm1.SQLDisconnected(Sender: TObject);
begin
Circle1.Fill.Color := $FFFF0000;
end;
FinishConnected:
procedure TForm1.FinishConnected(Sender: TObject);
begin
if TThread(Sender).FatalException <> nil then
begin
// something went wrong
ShowMessage ('Failure to connection');
//Exit;
end;
end;
When the SQL Server is online, I would like to see a green circle. When the connection with server goes downs, the circle should be red.
You are creating and opening the ADO connection in the context of the main UI thread, not in the context of the worker thread. So your worker thread is basically useless. You could have just used TThread.ForceQueue() instead to get the same effect.
ADO uses COM technology internally, so you can't really use it across thread boundaries anyway. If you want to use ADO in a thread, give the thread its own ADO Connection and Query objects. Do all your SQL work in the context of the thread, and synchronize status updates with the main UI thread as needed.
Also, you need to initialize the COM library in the worker thread before it can work with ADO.
Try something more like this instead:
procedure TForm1.Button1Click(Sender: TObject);
var
Thread : TThread;
ConnStr: string;
begin
ConnStr := 'Provider=SQLNCLI11.1;'+
'Persist Security Info=False;'+
'User ID='+Edit1.Text+';'+
'Initial Catalog='+Edit2.Text+';'+
'Data Source='+Edit3.Text+';'+
'Initial File Name="";'+
'Server SPN="";'+
'password="'+Edit4.Text+'"';
Thread := TThread.CreateAnonymousThread(
procedure
var
ADOConnectionSQL: TADOConnection;
ADOQuerySQL: TADOQuery;
begin
CoInitialize(nil);
try
ADOConnectionSQL := TADOConnection.Create(nil);
try
ADOConnectionSQL.LoginPrompt := False;
ADOConnectionSQL.ConnectionString := ConnStr;
ADOConnectionSQL.Open;
TThread.Queue(nil,
procedure
begin
Circle1.Fill.Color := TAlphaColorRec.Green;
end
);
ADOQuerySQL := TADOQuery.Create(nil);
try
ADOQuerySQL.Connection := ADOConnectionSQL;
// use ADOQuerySQL as needed...
finally
ADOQuerySQL.Free;
end;
finally
ADOConnectionSQL.Free;
end;
finally
CoUninitialize;
end;
end);
Thread.OnTerminate := SQLFinished;
Thread.Start;
end;
procedure TForm1.SQLFinished(Sender: TObject);
begin
Circle1.Fill.Color := TAlphaColorRec.Red;
if TThread(Sender).FatalException <> nil then
begin
// something went wrong
ShowMessage('Failure! ' + Exception(TThread(Sender).FatalException).Message);
end;
end;
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?
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.
I'm struggling with some anonymous methods in Delphi.
When a call the Execute method and the timer created inside that method timeout, it throws a "privileged instruction" exception.
Is that because my anonymous function go out of scope?
unit OneShotTimerReloaded;
interface
uses
System.SysUtils, System.Classes;
type
IOneShotTimerReloaded = interface
['{51DE72F0-4784-4CEB-A065-0B64D6EEA626}']
procedure Execute(Proc: TProc; TimeOut: Cardinal = 1000); overload;
procedure Execute(Proc: TProcedure; TimeOut: Cardinal = 1000); overload;
procedure Execute(Event: TNotifyEvent; TimeOut: Cardinal = 1000; Sender: TObject = nil); overload;
end;
TOneShotTimerReloaded = class(TInterfacedObject, IOneShotTimerReloaded)
public
procedure Execute(Proc: TProc; TimeOut: Cardinal = 1000); overload;
procedure Execute(Proc: TProcedure; TimeOut: Cardinal = 1000); overload;
procedure Execute(Event: TNotifyEvent; TimeOut: Cardinal = 1000; Sender: TObject = nil); overload;
end;
implementation
uses
Winapi.Windows;
{ TOneShotTimerReloaded }
procedure TOneShotTimerReloaded.Execute(Proc: TProc; TimeOut: Cardinal);
var
TimerID: UIntPtr;
begin
TimerID := SetTimer(HWND(0), 0, TimeOut, #procedure
begin
if (Assigned(Proc)) then
Proc;
KillTimer(HWND(0), TimerID);
end
);
end;
procedure TOneShotTimerReloaded.Execute(Proc: TProcedure; TimeOut: Cardinal);
var
TimerID: UIntPtr;
begin
TimerID := SetTimer(HWND(0), 0, TimeOut, #procedure
begin
if (Assigned(Proc)) then
Proc;
KillTimer(HWND(0), TimerID);
end
);
end;
procedure TOneShotTimerReloaded.Execute(Event: TNotifyEvent; TimeOut: Cardinal; Sender: TObject);
var
TimerID: UIntPtr;
begin
TimerID := SetTimer(HWND(0), 0, TimeOut, #procedure
begin
if (Assigned(Event)) then
Event(Sender);
KillTimer(HWND(0), TimerID);
end
);
end;
end.
The way I'm currently using this class is:
procedure TForm1.FormCreate(Sender: TObject);
var
t1: TOneShotTimerReloaded;
t2: TOneShotTimerReloaded;
begin
t1 := TOneShotTimerReloaded.Create;
t2 := TOneShotTimerReloaded.Create;
t1.Execute(btn1Click, 5000, btn1);
t2.Execute(procedure begin ShowMessage('Anonymous'); end, 2000);
// Not worried with t1 and t2 memory leaks yet!!! ;)
end;
Any ideas or suggestions are appreciated. Thanks!
You cannot use an anonymous procedure for a Win32 API callback, any more than you can use a non-static class method (without writing a proxy stub), or a local inner function (not safely, anyway). An anonymous procedure is implemented as a compiler-generated reference-counted interface that has a hidden Invoke() method that is executed whenever the procedure is called. That does not match the signature that SetTimer() (or any other API) is expecting for its callback.
Your code is essentially (but not exactly) doing the following behind the scenes:
type
TOneShotTimerReloaded_Execute_AnonProc = interface(IInterface)
procedure Invoke;
end;
TOneShotTimerReloaded_Execute_AnonProc_Impl = class(TInterfacedObject, TOneShotTimerReloaded_Execute_AnonProc)
public
Captured_Proc: ^TProc;
Captured_TimerID: ^UIntPtr;
procedure Invoke;
end;
procedure TOneShotTimerReloaded_Execute_AnonProc_Impl.Invoke;
begin
if (Assigned(Captured_Proc^)) then
Captured_Proc^();
KillTimer(HWND(0), Captured_TimerID^);
end
procedure TOneShotTimerReloaded.Execute(Proc: TProcedure; TimeOut: Cardinal);
var
TimerID: UIntPtr;
AnonProc: TOneShotTimerReloaded_Execute_AnonProc;
begin
AnonProc := TOneShotTimerReloaded_Execute_AnonProc_Impl.Create;
AnonProc.Captured_Proc := #Proc;
AnonProc.Captured_TimerID := #TimerID;
TimerID := SetTimer(HWND(0), 0, TimeOut, #AnonProc);
end;
See why it cannot possibly ever work?
Even if it were possible, your anonymous procedures are missing the input parameters that SetTimer() passes to its callback, as well as the stdcall calling convention, so you would be mismanaging the call stack anyway.
Your use of the # address operator is hiding compiler errors from you. Get rid of # and let the compiler fail. That should have been your first indication that you are doing something wrong.
To do what you are attempting, you are going to have to create a dynamic proxy stub (similar to what Classes.MakeObjectInstance() does) so SetTimer() can call your Proc handlers (almost) directly. Anonymous procedures will not help you with that.