I have a TIdTCPClient which is trying to connect to a host which is not online.
UPDATE:
After diving a bit deeper into WINSOCK2 it seems like this is indeed an issue which is depending on your operating system. Maybe there will be a fix in a future release.
(See the comments of this question for more details)
Setup:
Delphi 10 Seattle
Windows 7 64-Bit
Indy 10.6.2.5311
The ConnectTimeout is set to 5000 ms so I would expect to get at least a ConnectTimeout after 5 seconds. However on my current machine it takes over 20 seconds to receive that Timeout.
So far I see that the ConnectionTimeout is handled correctly but on TIdIOHandlerStack.ConnectClient there is an WaitFor on the thread which performs the actual connection attempt.
I think this is causing the delayed connection timeout, but I don't know what I could do about that. Any Ideas?
Code:
procedure TForm1.btn1Click(Sender: TObject);
begin
try
Self.mmo1.Lines.Add(TimeToStr(now));
Self.idtcpclnt1.Host := '192.148.89.112';
Self.idtcpclnt1.Port := 9200;
Self.idtcpclnt1.Connect;
except on E: Exception do
Self.mmo1.Lines.Add(TimeToStr(now)+ ' : '+E.Message);
end;
end;
procedure TForm1.idtcpclnt1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
Self.mmo1.Lines.Add(TimeToStr(now)+ ' : ' +AStatusText);
end;
Result of this code:
Related
I am trying to configure a FireDAC TFDQuery component so it fetches records on demand in batches of no more than 500, but I need it to report back what is the total record count for the query not just the number of fetched records. The FetchOptions are configured as follows:
FetchOptions.AssignedValues = [evMode, evRowsetSize, evRecordCountMode, evCursorKind, evAutoFetchAll]
FetchOptions.CursorKind = ckForwardOnly
FetchOptions.AutoFetchAll = afTruncate
FetchOptions.RecordCountMode = cmTotal
FetchOptions.RowSetSize = 500
This immediately returns all records in the table not just 500. I have tried setting RecsMax to 500, which works in limiting the fetched records, but RecordCount for the query shows only 500 not the total.
The FireDAC help file states that setting RecordCountMode to `cmTotal' causes FireDAC to issue
SELECT COUNT(*) FROM (original SQL command text).
Either there is a bug or I am doing something wrong!
I cannot see what other properties I can change. I am confused as to the relationship between RowSetSize and RecsMax and din't find the help file clarified.
I have tried playing with the properties of AutoFetchAll (Again confused as to this properties' purpose), but noting that is was set to afAll I set it to afTruncate to see if that would make a difference, but it didn't.
I have tested FetchOptions' fmOnDemand Mode with a FDTable component and a FDQuery component. Both with identical settings for FetchOptions ie RowSetSize=50. 425,000 rows in the dataset fetched over a network server.
FDTable performs as expected. It loads just 50 tuples and does so almost instantly. When pressing Ctrl+End to get to the end of the DBGrid display, it loads just 100 tuples. Whilst scrolling it rarely loads more than 100 tuples. Impact on memory negligible. But it is slow in scrolling.
FDQuery loads 50 tuples, but takes around 35 seconds to do so and consumes over 0.5GB of memory in the process. If you press Ctrl+Home to move to the end of the connected DBGrid it does so virtually instantly and in the process loads the entire table and consumes a further 700MB of memory.
I also experimented with CachedUpdates. The results above where with CachedUpdates off. When on, there was no impact at all on the performance of FDQuery (still poor), but for FDTable it resulted in it loading the entire table at start up, taking over half a minute to do so and consuming 1.2GBs of memory.
It looks like fmOnDemand mode is only practically usable with FDTable with CachedUpdates off and is not suitable for use with FDQuery at all.
The results of my tests using fmOnDemand with postgreSQL and MySQL are basically the same. With FDTable fmOnDemand only downloads what it needs limited to the RowSetSize. With a RowSetSize of 50 it initially downloads 50 tuples and no matter where you scroll to it never downloads more than 111 tuples (though doubtless that is dependent on the size of the connected DBGrid. If you disconnect the FDTable from a data source it initially downloads 50 tuples and if you then navigate to any record in the underlying table it downloads one tuple only and discards all other data.
FDQuery in fmOnDemand downloads only the initial 50 tuples when opened, but if you navigate by RecNo it downloads every tuple in between. I had rather hoped it would use LIMIT and OFFSET commands to get only records that were being requested.
To recreate the test for PostGre you need the following FireDAC components:
object FDConnectionPG: TFDConnection
Params.Strings = (
'Password='
'Server='
'Port='
'DriverID=PG')
ResourceOptions.AssignedValues = [rvAutoReconnect]
ResourceOptions.AutoReconnect = True
end
object FDQueryPG: TFDQuery
Connection = FDConnectionPG
FetchOptions.AssignedValues = [evMode, evRowsetSize]
end
object FDTable1: TFDTable
CachedUpdates = True
Connection = FDConnectionPG
FetchOptions.AssignedValues = [evMode, evRowsetSize, evRecordCountMode]
FetchOptions.RecordCountMode = cmFetched
end
If you wish to recreate it with MYSQL, you will basically need the same FireDAC components, but the FDConnectionneeds to be set as follows:
object FDConnectionMySql: TFDConnection
Params.Strings = (
'DriverID=MySQL'
'ResultMode=Use')
ResourceOptions.AssignedValues = [rvAutoReconnect]
ResourceOptions.AutoReconnect = True
end
You'll need an edit box, two buttons, a checkbox, a timer and a label and the following code:
procedure TfrmMain.Button1Click(Sender: TObject);
begin
if not FDQueryPG.IsEmpty then
begin
FDQueryPG.EmptyDataSet;
FDQueryPG.ClearDetails;
FDQueryPG.Close;
end;
if not FDTable1.IsEmpty then
begin
FDTAble1.EmptyDataSet;
FDTable1.ClearDetails;
FDTable1.Close;
end;
lFetched.Caption := 'Fetched 0';
lFetched.Update;
if cbTable.checked then
begin
FDTable1.TableName := '[TABLENAME]';
FDTable1.Open();
lFetched.Caption := 'Fetched '+ FDTable1.Table.Rows.Count.ToString;
end
else
begin
FDQueryPG.SQL.Text := 'Select * from [TABLENAME]';
FDQueryPG.open;
lFetched.Caption := 'Fetched '+ FDQueryPG.Table.Rows.Count.ToString;
end;
timer1.Enabled:=true;
end;
procedure TfrmMain.Button2Click(Sender: TObject);
begin
if cbTable.Checked then
FDTable1.RecNo := strToInt(Edit1.Text)
else
FDQueryPG.RecNo := strToInt(Edit1.Text);
end;
procedure TfrmMain.cbTableClick(Sender: TObject);
begin
timer1.Enabled := False;
end;
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
if cbTable.checked then
lFetched.Caption := 'Fetched '+ FDTable1.Table.Rows.Count.ToString
else
lFetched.Caption:='Fetched '+FDQueryPG.Table.Rows.Count.ToString;
lFetched.Update;
end;
I want to create windows GUI application using Lazarus that able to drag file from explorer to the TEdit widget and show the file path.
I had read and tried some delphi tutorials, it said that you need to handle the WM_DROPFILES message, but I still can't get it works. So I'm thinking if I should try the simple way first by making application that able to drag file to TForm instead.
So I followed this example, but it doesn't work too.
Here is the full code:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ShellAPI;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
protected
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(self.Handle, True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DragAcceptFiles(self.Handle, False);
end;
procedure TForm1.WMDropFiles(var Msg: TMessage);
begin
ShowMessage('hello'); // never gets called
end;
end.
The TForm1.FormCreate and TForm1.FormDestroy are working fine but the TForm1.WMDropFiles method never gets called.
Anyone know the solution? Could be the Lazarus/Free-Pascal windows library behavior differs from Delphi's ?
FYI, I'm using lazarus-1.6.0-fpc-3.0.0-win32 on Windows 7 64 bit.
DragAcceptFiles is not true (for Lazarus), since it is a platform-dependent code ))
There is the correct cross-platform code: OnDropFiles - Only works with dock icon, not with Application Form
He doesn't use "Windows", "Messages" and "ShellAPI".
1 Set property "AllowDropFiles" of MainForm to True;
2 Declaration of the procedure:
type
{ TMainForm }
TMainForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure OnApplicationDropFiles(Sender: TObject; const FileNames: array of String);
public
end;
3 The procedure:
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.AddOnDropFilesHandler(#OnApplicationDropFiles);
end;
procedure TMainForm.OnApplicationDropFiles(Sender: TObject; const FileNames: array of String);
begin
ShowMessage('Files dropped');
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
Application.RemoveOnDropFilesHandler(#OnApplicationDropFiles);
end;
Below answer solely elaborates on Win32WidgetSet which the question is apparently about.
First, as an answer to the question asked, the reason why WM_DROPFILES handler of the form is not called is that, simply the message is not delivered to the respective window procedure of the control class that the message is sent. LCL code is selective in what messages are delivered. Some details are in next paragraph, safe to skip...
After the message is dispatched (DispatchMessage of the Win32 API in procedure TWin32WidgetSet.AppProcessMessages of "win32object.inc" in "Win32Int.pp", which is the main message loop), the window procedure of the control's window (function WindowProc of "win32callback.inc" in "Win32Int.pp") constructs a WindowProcHelper object and calls its DoWindowProc (still in "win32callback.inc") function. This function has a huge message case, and it is here decided if a message will make it through the DeliverMessage function (which is in "LCLMessageGlue.pp"). WM_DROPFILES is handled differently and then it is not "deliver"ed. Any message which makes it to DeliverMessage is delivered to the control class' window procedure which the control it is sent belongs to (TControl.WndProc in "control.inc" of "controls.pp", or any override, f.i. TWinControl.WndProc in "wincontrol.inc" of "controls.pp") if it is a control, or dispatched otherwise.
Second, to achieve the desired behavior of handling dropped files on the edit control, one obvious solution, mentioned in so many places - even in lazarus' documentation as linked in a comment to the question, is to subclass the window of the control. Your subclass will be delivered the message before LCL has a chance to handle it, hence you can act on the message.
But, once you trace the code in TWindowProcHelper.HandleDropFiles in "win32callback.inc", it becomes apparent how easy it would be to set up the special handling of WM_DROPFILES in LCL so that only the edit control handles dropped files. Normally this is for handling at the form level as already mentioned in a previous answer, but a form also actually acts on messages received on behalf of its children.
No need to go into specifics as it is just implementation detail and I don't know if it is intended but, set AllowDropFiles of the form to true, and then in the OnCreate handler of the form, unregister the form as a drop target (which is automatically registered) and register the edit.
procedure TForm1.FormCreate(Sender: TObject);
begin
AllowDropFiles:= True;
DragAcceptFiles(Handle, False);
DragAcceptFiles(Edit1.Handle, True);
end;
Only the edit will accept files, but you'd handle it still on the form's event handler.
procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String);
begin
if Length(FileNames) > 0 then
Edit1.Text := FileNames[0];
end;
It is also possible to use Application.OnDropFiles after the same setup, but I don't see any advantage over the previous method.
procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String);
var i : Integer;
aTxt: String;
begin
showmessage('oh it works, this is filename #1 ' + filenames[0])
end;
I want to execute long queries in a separate thread in order to be able to abort them and also to give feedback to the users. All of this is working but I sometimes get Access Violations because, I think, the processing of the OnNotice events is not done the right way and I would like to know the proper way of doing this.
I am using Devart's PgDAC and OmniThreadLibrary on Delphi 2010.
The PostgreSQL code that I execute is a stored procedure that contains things like :
RAISE NOTICE 'ad: %',myad.name;
Here are the interesting parts of my code :
procedure TFDecomptes.FormCreate(Sender: TObject);
begin
ThreadConnection := TPgConnection.Create(Self);
ThreadConnection.Assign(DM.PgConnection1);
end;
This ThreadConnection is the TPgConnection that will be used to execute the query (within a separate thread).
procedure TFDecomptes.BInterruptClick(Sender: TObject);
begin
ThreadConnection.BreakExec;
end;
This is what the "Interrupt query" button does. I'm not sure this is very "thread safe" since it is used in the main thread but does something on the TPgConnection dedicated to the query-execution thread.
procedure TFDecomptes.OmniEventMonitor1TaskMessage(const task: IOmniTaskControl; const msg: TOmniMessage);
begin
case msg.MsgID of
1: begin
CalculationError:=msg.MsgData.AsString;
end;
end;
end;
This is where I show errors happening during the thread execution (like SQL errors or query cancellation).
procedure TFDecomptes.PgConnectionNotice(Sender: TObject; Errors: TPgErrors);
var s:String;
begin
s:=Errors[Errors.Count-1].ToString;
if copy(s,1,4)='ad: ' then begin
delete(s,1,4);
LAD.Caption:=s;
end;
end;
This is the OnNotice event processing. All it is doing is modify a Label's caption.
procedure InternalExecQuery(const task: IOmniTask);
Var q:TPgSQL;
begin
q:=Task.Param['pgsql'];
Try
q.Execute;
Except
On E:Exception do task.Comm.Send(1,e.Message);
End;
end;
procedure TFDecomptes.StartClick(Sender: TObject);
begin
ThreadConnection.OnNotice:=PgConnectionNotice;
Timer1.Enabled:=True;
CalculationTask := CreateTask(InternalExecQuery, 'CalculeDecomptes')
.MonitorWith(OmniEventMonitor1)
.SetParameter('pgsql', PgSQL)
.Run;
end;
And this is how the query is run.
So the PgConnectionNotice event (running in the main thread) is attached to the ThreadConnection (used in the query-execution thread) and this is what I suspect to be generating these random access violations.
I don't know how to handle this. Should I use some kind of lock when inside PgConnectionNotice (Synchronize ?).
This is what I tried :
procedure TFDecomptes.OmniEventMonitor1TaskMessage(const task: IOmniTaskControl; const msg: TOmniMessage);
begin
case msg.MsgID of
1: begin
CalculationError:=msg.MsgData.AsString;
end;
2: begin
lad.caption:='Here';
end;
end;
end;
procedure TFDecomptes.PgConnectionNotice(Sender: TObject; Errors: TPgErrors);
begin
// I am not using the passed string in this test
CalculationTask.Comm.Send(2,Errors[Errors.Count-1].ToString);
end;
The message sent in PgConnectionNotice (with MsgId=2) is never received by OmniEventMonitor1TaskMessage.
I have tried using CalculationTask.Invoke but didn't understand how to call it in order to pass a string parameter (I don't think Delphi 2010 allows for anonymous functions).
When I tried the simpler action of cancelling the query like this, it stopped cancelling the query :
procedure TFDecomptes.DoTheInterrupt;
begin
ThreadConnection.BreakExec;
end;
procedure TFDecomptes.BInterruptClick(Sender: TObject);
begin
CalculationTask.Invoke(DoTheInterrupt);
end;
So I guess I shouldn't do the calls via CalculationTask. Should I store the task created in InternalExecQuery in a global variable and use that ?
The main problem is that I was confusing IOmniTask and IOmniTaskControl. IOmniTask is the background's interface that should be used to send messages to the main thread while IOmniTaskControl is the main thread's interface, used to talk to the background tasks.
So using CalculationTask (which is a IOmniTaskControl) inside PgConnectionNotice is a double mistake : since PgConnectionNotice is fired from within the background thread, I was sending messages to the background thread, from the background thread, using a main thread's variable.
So I added a global variable named RunningTask :
Var RunningTask : IOmniTask;
Set it to nil in the form's OnCreate and modify the task's code like this :
procedure InternalExecQuery(const task: IOmniTask);
Var q:TPgSQL;
begin
RunningTask := task;
try
q:=Task.Param['pgsql'];
Try
q.Execute;
Except
On E:Exception do task.Comm.Send(1,e.Message);
End;
finally
RunningTask := Nil;
end;
end;
And the OnNotice event now looks like :
procedure TFDecomptes.PgConnectionNotice(Sender: TObject; Errors: TPgErrors);
begin
if RunningTask=Nil then
// do nothing, old, pending notices
else
RunningTask.Comm.Send(2,Errors[Errors.Count-1].ToString);
end;
I know it is not clean to define a global variable although I know there will be at most one background task. I probably should have stored the IOmniTask reference within ThreadConnection because this is what Sender is in PgConnectionNotice.
I am automating an open source program written in Delphi. From the main form, I am performing the following loop:
for i := 0 to analysisNames.Count - 1 do begin
currentAnalysisName := analysisNames[i];
analysisID := DatabaseModule.GetAnalysisIDForName(analysisNames[i]);
frmIIGraph.autoMode := true;
frmIIGraph.ShowModal();
end;
As you can see, it opens a form called frmIIGraph. Inside that form, I must open another form, which I do with the following code:
procedure TfrmIIGraph.FormActivate(Sender: TObject);
begin
if autoMode then begin
events := DatabaseModule.GetEvents(analysisID);
frmEventEdit.autoMode := true;
frmEventEdit.OpenDialog(events,0,analysisID);
frmEventEdit.ShowModal();
//frmEventEdit.Close;
SetFocus;
ModalResult := mrOK;
PostMessage(Self.Handle,wm_close,0,0);
end;
end;
The form opened from the above method is called frmEventEdit. Within that form I am running this code:
procedure TfrmEventEdit.FormActivate(Sender: TObject);
begin
if autoMode then begin
btnRTK_CalcClick(nil);
ModalResult := mrOK;
PostMessage(Self.Handle,wm_close,0,0);
end;
end;
The problem is that the PostMessage(Self.Handle,wm_close,0,0); in the latter code works fine and closes the form, resuming the code on the frmIIgraph at SetFocus;. However, the PostMessage(Self.Handle,wm_close,0,0); in the IIGraph form code, does not close the graph form, so that execution can resume on the main form, for the next iteration of the loop. You have to manually close the graph for it to proceed.
Any help is appreciated.
Your fundamental problem is that you have coded all your business logic in GUI code. So you are not able to execute the code that you want to execute without the convoluted code seen in the question.
If you want to solve your real problem you will deal with the root cause of your woes. You will separate the business logic and the GUI code. You will arrange for your business logic to be able to be executed in the absence of GUI.
If you don't want to solve your real problem, and wish to continue with this madness, you need to post a WM_CLOSE message to frmIIGraph.Handle in the OnDeactivate event handler for TfrmEventEdit. Presumably the one you post in TfrmIIGraph.FormActivate is getting consumed by the sub-form's message loop, or perhaps some call to ProcessMessages. But I cannot endorse this as a sane way to proceed.
I have multithreaded application that loads my custom dll.
In this dll I need to create a window.
I'm doing it by creating new thread and inside it I'm trying to create this window, but I have got error that tells me: EInvalidOperation - Canvas does not allow drawing.
By searching in the net, I have discovered that I need custom message pump for that thread.
So, my question is, how properly do this?
What I do now is:
- external app is loading dll
- than this app in separte thread is calling Init function from dll
- Init function creates thread
- TMyThread is declared as:
type
TMyThread = class(TThread)
private
Form: TMyForm;
FParentHWnd: HWND;
FRunning: Boolean;
protected
procedure Execute; override;
public
constructor Create(parent_hwnd: HWND); reintroduce;
end;
constructor TMyThread.Create(parent_hwnd: HWND);
begin
inherited Create(False); // run after create
FreeOnTerminate:=True;
FParentHWnd:=parent_hwnd;
FRunning:=False;
end;
procedure TMyThread.Execute;
var
parent_hwnd: HWND;
Msg: TMsg;
XRunning: LongInt;
begin
if not Terminated then begin
try
try
parent_hwnd:=FParentHWnd;
Form:=TMyForm.Create(nil); // <-- here is error
Form.Show;
FRunning:=True;
while FRunning do begin
if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then begin
if Msg.Message <> WM_QUIT then
Application.ProcessMessages
else
break;
end;
Sleep(1);
XRunning:=GetProp(parent_hwnd, 'XFormRunning');
if XRunning = 0 then
FRunning:=False;
end;
except
HandleException; // madExcept
end;
finally
Terminate;
end;
end;
end;
The exception EInvalidOperation - Canvas does not allow drawing is fired before thread reaches my existing message pump code.
What do I do wrong or what is the right way to make it work?
Thanks for any help.
To create second GUI thread in a DLL, I must do things exactly as in standard application.
Can anyone confirm my thinking?
In the DLL begin...end. section I do:
begin
Application.CreateForm(THiddenForm, HiddenForm);
Application.Run;
end.
In the TMyThread.Execute I must do:
procedure TMyThread.Execute;
begin
if not Terminated then begin
try
try
Application.CreateForm(TMyForm, Form);
???? how to make a thread that has remained in this place until you close this window ???
except
HandleException; // madExcept
end;
finally
Terminate;
end;
end;
end;
Is this the right way? Could it be that simple?
The simplest way to run a message queue in a thread is as follows:
procedure PerformThreadLoop;
var
Msg: TMsg;
begin
while GetMessage(Msg, 0, 0, 0) and not Terminated do begin
Try
TranslateMessage(Msg);
DispatchMessage(Msg);
Except
Application.HandleException(Self);
End;
end;
end;
And in your thread procedure would look like this:
procedure TMyThread.Execute
begin
InitialiseWindows;
PerformThreadLoop;
end;
All that said, what you are attempting is not going to work. You appear to be trying to use VCL components away from the main thread. That is specifically not allowed. The VCL's threading model dictates that all VCL code is run on the main thread. Your attempts to create a VCL form away from the main thread are doomed to failure.
I would question your desire to create a new thread. A Delphi DLL can show VCL forms provided that it runs those forms out of the thread that loaded and called the DLL. You can call Show from that thread and show a modeless form. This means that you are relying on the host application's message queue to deliver messages to your windows. By and large this can be made to work. If your form is modal then you can simply call ShowModal and the form will be serviced by the standard Delphi modal message loop.
So my advice to you is to keep all your GUI in the host app's GUI thread. If your DLL is expected to show GUI, and is also expected to do that away from the host app's GUI thread then you are in trouble. But I think that's highly unlikely to be the case.
Earlier (a year ago) I stated this: "To create second GUI thread in a DLL, I must do things exactly as in standard application".
This is exactly what everybody who is searching for this solution should do.
Let me explain, step by step:
we must add our application object to our thread:
type
TMyThread = class(TThread)
private
ThreadApplication: TApplication;
now some modification to definition of procedure TMyThread.Execute;
procedure TMyThread.Execute;
begin
if not Terminated then begin
try
ThreadApplication:=TApplication.Create(nil);
try
ThreadApplication.Initialize;
ThreadApplication.CreateForm(TMyForm, Form);
ThreadApplication.Run;
finally
ThreadApplication.Free;
end;
finally
Terminate;
end;
end;
end;
so, this is it, now we have message pump in a second GUI thread in a DLL.
Recently I found confirmation to this solution in a Delphi-Jedi blog, wrote by Christian Wimmer:
http://blog.delphi-jedi.net/2008/05/27/winlogon-notification-package/
Thank You very much.