I'm having a hard time wrapping my head around using Synchronize from a TWebActionItem.
My webservice is a visual program with form TFormWebServices
var FormWebServices: TFormWebServices;
This has a property FWebBrokerBridge: TIdHTTPWebBrokerBridge
The FWebBrokerBridge registers TWebModuleWebServices as the classes to use for each incoming call:
FWebBrokerBridge.RegisterWebModuleClass(TWebModuleWebServices);
The TWebActionItem items in this class do the work reading a TWebRequest and writing a TWebResponse.
There is one handler that needs to use some VCL visual rendering (shared code with another app) and I want to Synchronize this with the main thread (FormWebServices).
Stub:
TWebModuleWebServices = class(TWebModule)
procedure WebModuleWebServicesTTGetDynReportAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModuleAfterDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
FResponse: TResBase; // JSON response object
end;
procedure TWebModuleWebServices.WebModuleWebServicesTTGetDynReportAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
lFrmDynRapport : TFormDynRapport; // A form containing the common code, has VCL components
begin
lResponse := (FResponse as TResGetDynReport); // TResGetDynReport = class(TResBase)
// ...
lFrmDynRapport := TFormDynRapport.Create(Self);
try
with lFrmDynRapport do
begin
// Do visual stuff with grids, read grid settings, fill lResponse with info specific for this webaction
end
finally
end
// ...
end;
procedure TWebModuleWebServices.WebModuleAfterDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var lJSO: ISuperObject; // SuperObject library
begin
lJSO := FResponse.ToJson;
// ...
Response.Content := lJSO.AsString;
Handled := true;
end;
Now how can I properly Synchronize the try/finally block?
I can get at the current thread and do something simple like:
lThread := TThread.CurrentThread;
TThread.Synchronize(lThread,procedure
begin
FormWebServices.MmoLog.Lines.Add('Synchronize test');
end);
but for anything more complex I'm stuck.
Defining local procedures and feeding these into Synchronize does not work (E2555 cannot capture symbol).
How can I extract the try/finally block so that I can properly execute it in the context of FormWebServices?
The trick is to put the entire block in an anonymous method (thanks for the tip, David):
if lFlexRapDM.DesignerCustomOpenDoc(lFlexRapDM.TimeTellReport) then
begin
.....
lThread := TThread.CurrentThread;
TThread.Synchronize(lThread,procedure
var l,lIndex : integer;
...
begin
lFrmDynRapport := TFormDynRapport.Create(Self);
try
with lFrmDynRapport do
begin
...
end; // with FrmDynReport
finally
lFrmDynRapport.Free;
end;
end);
...
end // if lFlexRapDM.DesignerCustomOpenDoc
Related
I have a important problem with building Indy Server/Clients realtime monitoring system...
I am using DELPHI 2010, and Indy version is 10.5.5.........
My purpose is that many client side PCs send screenshots continuosely(4~10fps) to Server, and Server have to send these screenshots frames to some monitoring PCs.
In other words....
Many clients -----send streams--------> to Server
Some monitors <---receive streams----- from Server
Of course, In the case of one client and one monitor with server works well...
But if connecting another clients or monitors, then server have been raising exceptions "Access violation at address 000000000.....", or "Invalid pointer operations" and disconnects client's connection or monitor's one.
At the result, client or monitor will be disconnected from server....
I have used idTCPClient component, described client and monitor code using thread for sending and receiving stream.
I am sure there is no problem with client and monitor side's Code...
But I think that there will be absolutely problem with server side.
For server side, I have used two TidTCPServer controls...
One is to receive streams from client PCs.And another is to send streams to monitor PCs.
server code is like below...
{one side----idTCPServerRecv is to receive screenshot streams from clients}
procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
Hb: TIdIOHandler;
TempStr: TStrings;
begin
Hb := AContext.Connection.IOHandler;
if Not Hb.InputBufferIsEmpty then
Begin
Hb.CheckForDisconnect(True, True);
AContext.Connection.IOHandler.CheckForDisconnect(True, True);
recv_Stream := TMemoryStream.Create;
recv_Stream.Clear;
if (ReceiveStream(AContext, TStream(recv_Stream)) = False) then
begin
ROutMsg :=AContext.Binding.PeerIP+' -> receiving failed: ' + IntToStr(recv_Stream.Size)+'byte';
recv_Stream.Free;
Exit;
end;
if recv_Stream.Size < 1024 then
begin
recv_Stream.Seek(0, soFromBeginning);
ROutMsg :=AContext.Binding.PeerIP+' -> captionString received('+
IntToStr(recv_Stream.Size)+' byte) : "'+StringFromStream(TStream(recv_Stream))+'"';
recv_Stream.Free;
end
else
begin
ROutMsg :=AContext.Binding.PeerIP+' -> screenshot received: ' + KBStr(recv_Stream.Size)+' KB';
if G_Sendable = False then
begin
send_Stream:=TMemoryStream.Create;
send_Stream.Clear;
recv_Stream.Seek(0, soFromBeginning);
send_Stream.Seek(0, soFromBeginning);
send_Stream.CopyFrom(recv_Stream, recv_Stream.Size);
G_Sendable :=True;
end;
recv_Stream.Free;
end;
end;
Application.ProcessMessages;
WaitForSingleObject(Handle, 1);
end;
{another side----idTCPServerSend is to send screenshot streams to monitors}
procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
begin
if G_Sendable then
begin
send_Stream.Seek(0,soFromBeginning);
if (SendStream(AContext, TStream(send_Stream)) = False) then
begin
SOutMsg :=AContext.Binding.PeerIP+' -> sending failed -> ' + KBStr(send_Stream.Size)+' KB';
send_Stream.Free;
G_Sendable :=False;
Exit;
end;
SOutMsg :=AContext.Binding.PeerIP+' -> sending successful-> ' + KBStr(send_Stream.Size)+' KB';
send_Stream.Free;
G_Sendable :=False;
end;
Application.ProcessMessages;
WaitForSingleObject(Handle, 1);
end;
What should I do for multi-clients connections with realtime exchange of streams...
Every client PC send screenshot stream 4~10 times per second...
And these streams must be sent to monitors corresponding
Please give me advice....
Your code is not even close to being thread-safe, which is why you are having errors. Every client thread in IdTCPServer_Recv is receiving their respective screeshots to a single shared recv_Stream variable, and then copying that data to a single shared send_Stream variable. All clients connected to IdTCPServer_Send are then reading and sending the same send_Stream at the same time. You are trampling memory all over the place.
You need to use a local variable instead of a shared variable to receive each screenshot, and you need to use a separate TStream object for each monitor client. Don't use a shared TStream for sending, and certainly don't use a global boolean variable to let each monitor client go at it. Have IdTCPServer_RecvExecute() actively create and pass along a new TMemoryStream object to each monitor client that needs to send the current screenshot.
Try something more like this:
uses
..., IdThreadSafe;
type
TMonitorContext = class(TIdServerContext)
public
Screenshots: TIdThreadSafeObjectList;
ScreenshotEvent: THandle;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
destructor Destroy; override;
end;
TScreenshotInfo = class
public
ClientIP: string;
ClientPort: TIdPort;
Data: TMemoryStream;
constructor Create;
destructor Destroy; override;
end;
constructor TMonitorContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList);
begin
inherited;
Screenshots := TIdThreadSafeObjectList.Create;
Screenshots.OwnsObjects := True;
ScreenshotEvent := CreateEvent(null, True, False, nil);
end;
destructor TMonitorContext.Destroy;
begin
Screenshots.Free;
CloseHandle(ScreenshotEvent);
inherited;
end;
constructor TScreenshotInfo.Create;
begin
inherited;
Data := TMemoryStream.Create;
end;
destructor TScreenshotInfo.Destroy;
begin
Data.Free;
inherited;
end;
{one side----idTCPServerRecv is to receive screenshot streams from clients}
procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
recv_stream: TMemoryStream;
monitors, queue: TList;
i: Integer;
screenshot: TScreenshotInfo;
monitor: TMonitorContext;
begin
recv_stream := TMemoryStream.Create;
try
if not ReceiveStream(AContext, recv_stream) then
begin
ROutMsg := AContext.Binding.PeerIP + ' -> receiving failed: ' + IntToStr(recv_Stream.Size) + ' byte';
Exit;
end;
if recv_Stream.Size < 1024 then
begin
recv_Stream.Position := 0;
ROutMsg := AContext.Binding.PeerIP + ' -> captionString received(' +
IntToStr(recv_Stream.Size) + ' byte) : "' + StringFromStream(recv_Stream) + '"';
end
else
begin
ROutMsg := AContext.Binding.PeerIP + ' -> screenshot received: ' + KBStr(recv_Stream.Size) + ' KB';
monitors := IdTCPServer_Send.Contexts.LockList;
try
// alternatively, only queue the screenshot to particular monitors
// that are actually interested in this client...
for i := 0 to monitors.Count-1 do
begin
monitor := TMonitorContext(monitors[i]);
screenshot := TScreenshotInfo.Create;
try
recv_Stream.Position := 0;
screenshot.Data.CopyFrom(recv_stream, 0);
screenshot.Data.Position := 0;
queue := monitor.Screenshots.LockList;
try
queue.Add(screenshot);
SetEvent(monitor.ScreenshotEvent);
finally
monitor.Screenshots.UnlockList;
end;
except
screenshot.Free;
end;
end;
finally
IdTCPServer_Send.Contexts.UnlockList;
end;
end;
finally
recv_stream.Free;
end;
end;
{another side----idTCPServerSend is to send screenshot streams to monitors}
procedure TIndyServerForm.FormCreate(Sender: TObject);
begin
IdTCPServer_Send.ContextClass := TMonitorContext;
end;
procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
var
monitor: TMonitorContext;
queue: TList;
i: Integer;
screenshot: TScreenshotInfo;
begin
monitor := TMonitorContext(AContext);
if WaitForSingleObject(monitor.ScreenshotEvent, 1000) <> WAIT_OBJECT_0 then Exit;
screenshot := nil;
try
queue := monitor.Screenshots.LockList;
try
if queue.Count > 0 then
begin
screenshot := TScreenshotInfo(queue[0]);
queue.Delete(0);
end;
if queue.Count = 0 then
ResetEvent(monitor.ScreenshotEvent);
finally
monitor.Screenshots.UnlockList;
end;
if screenshot = nil then Exit;
// you should send screenshot.ClientIP and screenshot.ClientPort to
// this monitor so it knows which client the screenshot came from...
if not SendStream(AContext, screenshot.Data) then
begin
SOutMsg := AContext.Binding.PeerIP + ' -> sending failed -> ' + KBStr(screenshot.Data.Size) + ' KB';
Exit;
end;
SOutMsg := AContext.Binding.PeerIP + ' -> sending successful-> ' + KBStr(screenshot.Data.Size) + ' KB';
finally
screenshot.Free;
end;
end;
On the 'monitor' side, a TIdTCPClient in a thread can listen for incoming screenshot data from the server. I have posted a blog article about server-side push messaging technique with Indy (source code) here:
Indy 10 TIdTCPServer: Server-side message push example
Additional server-side code is required to direct the incoming data to the monitoring clients. Actually you only need to add 'tags' (which could be boolean flags) to the context, indicating wether this connection is sending or monitoring screenshot data. How to assign custom properties to connection context and iterating over them is already answered in other questions here on SO.
My database is in a VPS and I should get some query from my tables
Because of getting query from server taking long time ( depending on Internet speed ! ) , I want to use threads to get queries
Now I create a thread and get query and then send result to my forms with sending and handling messages
I want to know is it possible to create and use a thread locally ?!?
My mean is :
procedure Requery;
var
...
begin
Create Thread;
...
Pass my Query Component to Thread
...
Getting Query in Thread;
...
Terminate and Free Thread
...
Do next jobs with Query;
...
end;
The main part is last part ( Do next jobs ... ) , I dont want to use query result in a message handler and I want to use them in the same procedure and after thread job
Is it possible ?!
I think this is not possible with Delphi TThread class and I should use other threading techniques ...
I`m using Delphi XE6
What you describe is not the best use of a thread. The calling code is blocked until the thread is finished. That negates the use of running code in parallel at all. You could just perform the query directly instead:
procedure Requery;
var
...
begin
...
// run query
// do next jobs with query
...
end;
That being said, since you are using XE6, you can create a "local" thread by using the TThread.CreateAnonymousThread() method, specifying an anonymous procedure that "captures" the variables you want it to work with, eg:
procedure Requery;
var
Event: TEvent;
H: THandle;
begin
Event := TEvent.Create;
try
TThread.CreateAnonymousThread(
procedure
begin
try
// run query in thread
finally
Event.SetEvent;
end;
end
).Start;
H := Event.Handle;
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_ALLINPUT) = (WAIT_OBJECT_0+1) do
Application.ProcessMessages;
finally
Event.Free;
end;
// Do next jobs with query
...
end;
Alternatively:
procedure Requery;
var
Thread: TThread;
H: THandle;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
// run query in thread
end
);
try
Thread.FreeOnTerminate := False;
H := Thread.Handle;
Thread.Start;
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_ALLINPUT) = (WAIT_OBJECT_0+1) do
Application.ProcessMessages;
finally
Thread.Free;
end;
// Do next jobs with query
...
end;
However, threading is more useful when you let it run in the background while you do other things and then you act when the thread has finished its work. For example:
procedure TMyForm.Requery;
var
Thread: TThread;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
// run query in thread
end
);
Thread.OnTerminate := QueryFinished;
Thread.Start;
end;
procedure TMyForm.QueryFinished(Sender: TObject);
begin
if TThread(Sender).FatalException <> nil then
begin
// something went wrong
Exit;
end;
// Do next jobs with query
end;
I think that using a thread this way isn't a good idea, but the answer is yes. You can do it.
procedure LocalThread;
var
LThread: TCustomThread; //Your thread class
LThreadResult: xxxxxxx//Your result type
begin
LThread := TCustomThread.Create(True);
try
//Assign your properties
LThread.Start;
//Option A: blocking
LThread.WaitFor;
//Option B: non blocking
while not LThread.Finished do
begin
Sleep(xx);
//Some progress here ??
end;
//Here query your thread for your result property
LThreadResult := LThread.MyResultProperty;
finally
LThread.Free;
end
//Do next jobs with LThreadResult
end;
Yes you can do that.
The way I would do it is to add an event-handler to your form.
You'll have to link the event-handler in code, but that's not that difficult.
Create a thread like so:
TMyEventHandler = procedure(Sender: TObject) of object;
type
TMyThread = class(TThread)
strict private
FDoneEvent: TMyEvent;
FDone: boolean;
FQuery: TFDQuery;
constructor Create(DoneEvent: TMyEventHandler; Query: TFDQuery);
procedure Execute; override;
function GetQuery: TFDQuery;
public
property Query read GetQuery;
end;
TForm1 = class(TForm)
FDQuery1: TFDQuery; //Do not connect the FDQuery1 to anything!
DataSource1: TDataSource;
DBGrid1: TDBGrid;
private
FOnThreadDone: TMyEventHandler;
FMyThread: TMyThread;
procedure DoThreadDone;
procedure ThreadDone;
public
property OnThreadDone: TMyEventHandler read FOnThreadDone write FOnThreadDone;
....
implementation
constructor TMyThread.Create(DoneEvent: TMyEvent; Query: TFDQuery);
begin
inherited Create(true);
FDoneEvent:= DoneEvent;
FQuery:= Query;
Start;
end;
procedure TMyThread.Execute;
begin
//Do whatever with the query
//when done do:
FDone:= true;
Synchonize(Form1.DoThreadDone);
end;
function TMyThread.GetQuery: TFDQuery;
begin
if not Done then Result:= nil else Result:= FQuery;
end;
procedure TForm1.DoThreadDone;
begin
if Assigned(FOnThreadDone) then FOnThreadDone(Self);
end;
procedure TForm1.ThreadDone(Sender: TObject);
begin
ShowMessage('Query is done');
//Now you can display the result of the query, by wiring it
//to a dataset.
MyDataSource1.Dataset:= FMyThread.Query;
FMyThread.Free;
end;
procedure TForm1.StartTheQuery;
begin
OnThreadDone:= Self.ThreadDone;
FMyThread:= TMyThread.Create(OnThreadDone, FDQuery1);
end;
Now the query will run in the background and signal your event handler when it is done. Meanwhile you can do all the mousing around and user interaction you want without having to worry. Note that you cannot use FDQuery1 at all whilst the thread is using it, and you cannot have FDQuery1 wired to a DataSource whilst it's the thread is running with it.
Leave it unwired and wire it in the ThreadDone event handler as shown.
I am trying to call a function from another unit/class which would take some time in performing the task and would return a string value. I couldn't find a good reference something similar to C# async-await like simple approach in Delphi. Using Omni Thread library seems a good idea for me.
A simple example will be a great start for me.
Sample approach:
procedure TForm1.button1Click(Sender: TObject);
begin
// notify before starting the task
memo1.Lines.Add('calling a asynchronous function..');
// call to the function that takes some time and returns a string value
memo1.Lines.Add(GetMagicString);
// notify that the task has been completed
memo1.Lines.Add('Results fetched successfully.');
end;
Here, the function GetMagicString should process the result asynchronously. Once the result is obtained, only then the program should notify that the task has been completed. By the way, I'm using Delphi-XE.
Edit1:
Here is what I tried. But I am still unable to figure out the proper way to make the job done. The problem is how to return the value.
.....
private
ResultValue: IOmniFuture<string>;
.........
.....
function TForm1.FutureGet: string;
begin
Sleep(3000);
Result := 'my sample magic string response ' + IntToStr(Random(9999));
end;
procedure TForm1.FutureGetTerminated;
begin
// This code fired when the task is completed
memo1.Lines.Add(ResultValue.Value);
end;
function TForm1.GetMagicString: string;
begin
ResultValue := Parallel.Future<string>(FutureGet,
Parallel.TaskConfig.OnTerminated(FutureGetTerminated));
end;
Here, using Result := ResultValue.Value feezes the UI.
Edit2
I made changes as per the answer provided.
MainForm Code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Unit2;
type
TForm1 = class(TForm)
memo1: TMemo;
button1: TButton;
procedure button1Click(Sender: TObject);
private
FOnStringReceived: TMyEvent;
procedure StringReceived(const AValue: string);
property OnStringReceived: TMyEvent read FOnStringReceived write FOnStringReceived;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.button1Click(Sender: TObject);
var
MyObject: TMyClass;
begin
// notify before starting the task
memo1.Lines.Add('calling a asynchronous function..');
// call to the function that takes some time and returns a string value
MyObject := TMyClass.Create;
OnStringReceived := StringReceived;
try
MyObject.GetMagicStringInBackground(OnStringReceived);
finally
MyObject.Free;
end;
end;
procedure TForm1.StringReceived(const AValue: string);
begin
memo1.Lines.Add(AValue);
// notify that the task has been completed
memo1.Lines.Add('Results fetched successfully.');
end;
end.
Other Unit Code:
unit Unit2;
interface
uses SysUtils, OtlTask, OtlParallel, OtlTaskControl;
type
TMyEvent = procedure(const aValue: string) of object;
type
TMyClass = class
private
FOnStringReceived: TMyEvent;
function GetMagicString: string;
public
procedure GetMagicStringInBackground(AEvent: TMyEvent);
end;
implementation
{ TMyClass }
function TMyClass.GetMagicString: string;
begin
Sleep(3000);
Result := 'my sample magic string response ' + IntToStr(Random(9999));
end;
procedure TMyClass.GetMagicStringInBackground(AEvent: TMyEvent);
var
theFunctionResult: string;
begin
Parallel.Async(
procedure
begin
theFunctionResult := GetMagicString;
end,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
if Assigned(AEvent) then
AEvent(theFunctionResult);
end)
);
end;
end.
Yes, the code works as expected. I just want to know if this is the best way of doing what I really want to perform.
You would normally use a future in a case where you want something executed in the background but still need the result in the same execution path. It basically lets you do something in the background while doing another thing in the main thread and you can then use the result of the background thread.
What you need to use is the Async abstraction that TLama linked to:
In your case it would be:
procedure TForm1.DoSomething;
var
theFunctionResult: string;
begin
memo1.Lines.Add('calling a asynchronous function..');
Parallel.Async(
procedure
begin
// executed in background thread
theFunctionResult := GetMagicString;
end,
procedure
begin
// executed in main thread after the async has finished
memo1.Lines.Add(theFunctionResult);
// notify that the task has been completed
memo1.Lines.Add('Results fetched successfully.');
end
);
end;
This is a bit messy but you should get the idea. You need to make sure that your async code is completed before you destroy the form that owns this code (TForm1).
If you want to try and setup a system that will call an event when the code completes then you can do something like this:
type
TMyEvent = procedure(const aValue: string) of object;
procedure GetMagicStringInBackground(AEvent: TMyEvent);
var
theFunctionResult: string;
begin
Parallel.Async(
procedure
begin
// executed in background thread
theFunctionResult := GetMagicString;
end,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
// executed in main thread after the async has finished
if Assigned(AEvent) then
AEvent(theFunctionResult );
end
)
);
end;
You can then put the threaded code in the GetMagicString unit and just call the method above from your form passing in an event that will get called when it completes.
I am using Delphi 2007 and threads.
My problem (sorry, i'll try to explain better):
1) I created a file "utilities.pas" where i have the function i use more.
2) I created a new program, in this program i have one thread
3) in the execute method of the thread i call one function in my file "utilities.pas".
this function connects to an ftp using clever components (tclftp). This components logs the server responce in a dedicated event. What i would like to do is to save the log in a stringlist and then send the stringlist back to the calling thread.
This is part of the file "utilities.pas":
// I created TEventHandlers because it's the only way to assign the event runtime
// without having a class
type
TEventHandlers = class
procedure clFtp1SendCommand(Sender: TObject; const AText: string);
end;
var EvHandler: TEventHandlers;
// this is the porcedure called from the thread. i want to send the stringlist
// back to it containing the ftp log
procedure Test(VAR slMain: tStringlist);
var cFTP: TclFtp;
begin
cFTP := TclFtp.Create(nil);
cFTP.Server := 'XXX';
cFTP.UserName := 'XXX';
cFTP.Password := 'XXX';
cFTP.OnSendCommand := EvHandler.clFtp1SendCommand;
// i connect to the ftp
cFTP.Open;
FreeAndNil(cFTP);
end;
procedure TEventHandlers.clFtp1SendCommand(Sender: TObject; const AText: string);
begin
// here the component (cftp) sends me back the answer from the server.
// i am logging it
// HERE IT'S THE PROBLEM:
// I can't reach slMain from here.....
slmain.add(Atext);
end;
this is the calling thread:
procedure TCalcThread.Execute;
var slMain: tstringlist;
begin
inherited;
slmain := tstringlist.create(nil);
Test(slmain);
if slMain.count > 0 then
slMain.savetofile('c:\a.txt');
// i won't free the list box now, but in the thread terminated.
end;
this is the main program:
procedure TfMain.ThreadTerminated(Sender: TObject);
Var ExThread: TCalcThread;
begin
ExThread := (Sender as TCalcThread);
if ExThread.slMain.Count > 0 then
ExThread.slMain.SaveToFile('LOG\Errori.log');
freeandnil(slMain);
end;
Please can anybody help me in solving this? I really don't know what to do.
I hope now it more clear.
p.s. thanks for all the answer..
Another approach would be to have your thread object have its own instance of the stringlist and its own cFTP. If you need to have one "master thread" that everything writes to (perhaps for a summary of what each thread accomplished), use this class:
TThreadStringList by Tilo Eckert
http://www.swissdelphicenter.ch/torry/showcode.php?id=2167
I think one (BAD) approach would be to create a pool of components in the main thread or at design time, and assign one to each thread. i.e. 5 instances of cFTP, 5 stringlists, 5 threads.
Update: Martin James points out why this is a terrible idea, and I agree. So don't do this. Post stays as a deterrent.
Intercept the event within the thread class, and fire an own typed event from within that handler. Synchronize this call! And try to prevent the global variable. All this as follows:
type
TFtpSendCommandEvent = procedure(Mail: TStrings; const AText: String) of object;
TMyThread = class(TThread)
private
FclFtp: TclFtp;
FslMail: TStrings;
FOnFtpSendCommand: TFtpSendCommandEvent;
FText: String;
procedure clFtpSendCommand(Sender: TObject; const AText: String);
procedure DoFtpSendCommand;
protected
procedure Execute; override;
public
// You could add this property as parameter to the constructor to prevent the
// need to assign it separately
property OnFtpSendCommand: TFtpSendCommandEvent read FOnFtpSendCommand
write FOnFtpSendCommand;
end;
// If you dont want to make this a property or private field of the thread class:
var
EvHandler: TFtpSendCommandEvent;
{ TMyThread }
procedure TMyThread.clFtpSendCommand(Sender: TObject; const AText: string);
begin
// Store the AText parameter temporarily in a private field: Synchronize only
// takes a parameterless method
FText := AText;
Synchronize(DoFtpSendCommand);
end;
procedure TMyThread.DoFtpSendCommand;
begin
if Assigned(FOnFtpSendCommand) then
FOnFtpSendCommand(FslMail, FText);
// Or, if you really like to use that global variable:
if Assigned(EvHandler) then
EvHandler(FslMail, FText);
end;
procedure TMyThread.Execute;
begin
...
FclFtp := TclFtp.Create(nil);
FslMail := TStringList.Create(nil);
try
FclFtp.Server := 'XXX';
FclFtp.UserName := 'XXX';
FclFtp.Password := 'XXX';
FclFtp.OnSendCommand := clFtpSendCommand;
FclFtp.Open;
finally
FreeAndNil(FclFtp);
FreeAndNil(FslMail);
end;
...
end;
I´m having a few problems trying to download a file with 14mb using a TThread.
When I put the download code into the TDataModule, the download is ok, but after a refactoring and move the code to TThread.Execute, on DownloadUrl.ExecuteTarget I receive the error message on the Title.
The code in the TThread:
procedure TThreadDownload.Execute;
var
DownloadFile: TDownloadUrl;
begin
try
DownloadFile := TDownLoadURL.Create(nil);
DownloadFile.URL := 'http://.....';
DownloadFile.Filename := 'c:\';
DownloadFile.OnDownloadProgress := URL_OnDownloadProgress; //Procedure created to update the progressbar.
DownloadFile.ExecuteTarget(nil);
DownloadFile.Free;
except
on E: Exception do
begin
MessageDlg('Error'+#13+#10+E.Message,
mtInformation, [mbOK], 0);
end;
end;
end;
Any idea about what is wrong?
Thanks.
I solved the problem:
after read the code of DownloadUrl, I made little changes in the code, and now it´s working fine.
Code OK:
procedure TThreadDownload.AtualizarTela;
begin
with _Form do
begin
TcxProgressBar(_Form.FindComponent(_ProgressBar.Name)).Properties.Max := _TotalDownload;
TcxProgressBar(_Form.FindComponent(_ProgressBar.Name)).Position := _StatusDownload;
end;
end;
constructor TThreadDownload.Create(CreateSuspended: Boolean; AForm: TFrmMyFormWithProgress; AProgress: TcxProgressBar; PathUrl, PathLocal: String);
begin
inherited Create(CreateSuspended);
_Form := AForm;
_ProgressBar := AProgress;
_PathUrl := PathUrl;
_PathLocal := PathLocal;
FreeOnTerminate := True;
end;
procedure TThreadDownload.Execute;
var
DownloadFile: TDownloadUrl;
begin
try
DownloadFile := TDownloadUrl.Create(nil);
DownloadFile.URL := _PathUrl;
DownloadFile.Filename := _PathLocal;
DownloadFile.OnDownloadProgress := URL_OnDownloadProgress;
DownloadFile.ExecuteTarget(_Form);
DownloadFile.Free;
except
on E: Exception do
begin
MessageDlg('Error Message'+#13+#10+E.Message, mtInformation, [mbOK], 0);
end;
end;
end;
procedure TThreadDownload.URL_OnDownloadProgress(Sender: TDownLoadURL; Progress,
ProgressMax: Cardinal; StatusCode: TURLDownloadStatus; StatusText: String;
var Cancel: Boolean);
begin
_TotalDownload := ProgressMax;
_StatusDownload := Progress;
Synchronize(AtualizarTela);
end;
Do not do it, because TDownloadUrl would not work properly. If you would create 2 or more objects base on TDownloadUrl class and make them download simultaneously they would not return results, each thread will remain frozen. Even if you will free the objects after this collision has happened (I freed them from main thread), it would take exactly 5 minutes for the system to resolve it, but even after all the objects will be freed all other will be created "harmed" (meaning they will freeze straight away).
Here is my unit for Delphi-7 that may be used to reproduce this situation, if someone would like to check my statement.