I'm starting using the OTL for a simple project but I'm currently stuck at stopping and restarting a simple parallel loop.
Use case
The user is able to start a query to resolve hostnames of a list of IP address by pressing a button. At any moment, he can press a refresh button that will stop the current loop (CancelParallelResolveHostnames) and restart hostname resolution (StartParallelResolveHostnames).
But in all my implementations, the executable is dead locked at waiting for the FParallelResolveHostnamesWait or simply when I try to set FParallelResolveHostnames to nil.
I also noticed that the OnStop callback is not called when the loop is canceled. Is it the normal behaviour ?
References
IOmniParallelSimpleLoop interface
Foreach loop cancelation
IOmniWaitableValue and TOmniWaitableValue
Sample code
var
FAddressToProcess: TStringList;
FParallelResolveHostnames: IOmniParallelSimpleLoop;
FParallelResolveHostnamesCancelToken: IOmniCancellationToken;
FParallelResolveHostnamesWait: IOmniWaitableValue;
procedure TGuiConnections.StartParallelResolveHostnames;
var
TaskConfig: IOmniTaskConfig;
begin
FParallelResolveHostnamesWait := CreateWaitableValue;
FParallelResolveHostnamesCancelToken := CreateOmniCancellationToken;
TaskConfig := Parallel.TaskConfig;
TaskConfig.SetPriority(TOTLThreadPriority.tpLowest);
FParallelResolveHostnames := Parallel //
.For(0, FAddressToProcess.Count - 1) //
.TaskConfig(TaskConfig) //
.CancelWith(FParallelResolveHostnamesCancelToken) //
.NoWait //
.OnStop(
procedure
begin
FParallelResolveHostnamesWait.Signal;
end); //
FParallelResolveHostnames.NoWait.Execute(
procedure(i: Integer)
begin
ResolveHostname(i, FAddressToProcess[i]);
end);
end;
procedure TGuiConnections.CancelParallelResolveHostnames;
begin
if Assigned(FParallelResolveHostnamesCancelToken) then
begin
FParallelResolveHostnamesCancelToken.Signal;
end;
if Assigned(FParallelResolveHostnamesWait) then
begin
FParallelResolveHostnamesWait.WaitFor();
FParallelResolveHostnamesWait := nil;
FParallelResolveHostnames := nil;
FParallelResolveHostnamesCancelToken := nil;
end;
end;
Sample projects:
Project 7z archive using IOmniWaitableValue
Project 7z archive using FParallelResolveHostnames := nil
Related
I have a Delphi project that consists of two forms namely MainForm and DialogForm. When I click on Button1, the DialogForm should appear and stay on top until a process complete (the process takes a few seconds to complete).
The DialogForm includes a Timage component. When I click on the Button1 to show the DialogForm, the Gif image appears but without animation. This happens only when the process starts (without the process the animation works). What is the reason for this and how to keep the animation until closing the DialogForm?
procedure TMainForm.Button1Click(Sender: TObject);
var
gif: TGIFImage;
begin
Enabled:=false;
try
DialogForm.Show;
DialogForm.Refresh;
// The process is:
...
ipcAES1.Encrypt;//where ipcAES is part of the IPWorks Encrypt library
RichEdit1.Text:=ipcAES1.OutputMessage;
finally
Enabled:= true;
DialogForm.Close;
end;
end;
//---------------------------------------
procedure TDialogForm.FormShow(Sender: TObject);
var
gif: TGIFImage;
begin
gif := TGIFImage.Create;
gif.LoadFromFile('D:\preview.gif');
gif.Animate := True;
image1.Parent := Self;
image1.Left := 0;
image1.Top := 0;
image1.width := 800;
image1.height := 800;
image1.Picture.Assign(gif);
gif.Animate := True;
gif.Free;
end;
As said by many in this thread, because the processing is done in the main thread, the UI is not updated during this process.
To make sure the UI is updated while the process is running, let a separate thread do the processing:
procedure TForm1.Button1Click(Sender: TObject);
var
aProcessingThread: TThread;
begin
// First read all data needed by the process from UI controls (or other non-threadsafe parts)
<data> := ...;
// Then create a new (anonymous) thread with the code you need to run your process
aProcessingThread := TThread.CreateAnonymousThread(
procedure
begin
// create the objects you need to do the processing
ipcAES1 := Txxx.Create;
try
// Set the data
ipcAES1.<data> := <data>;
// Execute the proces:
// ...
ipcAES1.Encrypt;
finally
// When the process is done, use 'Synchronize' to interact with the UI
// again, so you can add the processed data to the RichtEdit and so on...
TThread.Synchronize(nil,
procedure
begin
// Now you can interact again with the UI
RichEdit1.Text := ipcAES1.OutputMessage;
Enabled:= true;
DialogForm.Close;
end);
ipcAES1.Free;
end;
end);
// The thread is now created, but not started/running, so you can now show
// the dialog and then start the thread, at which point the ButtonClick event
// exists, but the progress dialog is shown and the thread is running.
Enabled := False;
DialogForm.Show;
aProcessingThread.Start;
end;
Of course this only a basic example of how to use an (anonymous) thread to do some processing in the background.
Please note you need to handle Exceptions inside the thread (try/except).
A small tip regarding the TGifImage loading: you can just call Picture.LoadfromFile to load the gif as long as you include Vcl.Imaging.GIFImg in the uses clause.
procedure TForm1.FormShow(Sender: TObject);
begin
image1.Picture.LoadFromFile('D:\preview.gif');
image1.Parent := Self;
image1.Left := 0;
image1.Top := 0;
image1.width := Image1.Picture.Width;
image1.height := Image1.Picture.Height;
(image1.Picture.Graphic as TGIFImage).Animate := True;
end;
I just started developing a mobile app which has two forms, FRM_Main (Main Form) and FRM_Party (Party Form). We can open FRM_Party from FRM_Main by clicking on an Image. Code on Image is:
procedure TFRM_Main.IMAGE_PartyClick(Sender: TObject);
begin
FRM_Party := TFRM_Party.Create(Application);
FRM_Party.Show;
end;
Now, when FRM_Party calls the OnActivate event, I am loading some data in a TMSFMXTableView. That code is:
procedure TFRM_Party.FormActivate(Sender: TObject);
var
TableView : TTMSFMXTableViewItem;
I : Integer;
begin
if Class_My_Pro_and_func.Func_DataBaseConnection then // Checks wethere database connection is active or not if not then it connect with database and returns bool value.
Begin
UniQuery.Close;
UniQuery.SQL.Clear;
UniQuery.SQL.Text := 'select * from db_stock.tbl_party where Reg_ID = :Reg_ID and Party_Delete <> :Party_Delete order by Party_Name ';
UniQuery.ParamByName('Reg_ID').AsInteger := d_Glob_Reg_ID;
UniQuery.ParamByName('Party_Delete').AsString := 'F';
UniQuery.Open;
TABLEVIEW_Party.BeginUpdate;
if UniQuery.RecordCount > 0 then
begin
for I := 1 to UniQuery.RecordCount do
begin
TableView := TABLEVIEW_Party.Items.Add;
TableView.Caption := UniQuery.Fields[1].AsString;
TableView.Description := UniQuery.Fields[2].AsString + ' = ' + UniQuery.Fields[3].AsString;
TABLEVIEW_Party.EndUpdate;
UniQuery.Next;
end;
end
else
ShowMessage('No recored Found.');
End
end;
On FRM_Party is a Back button which takes the user to FRM_Main. This button code is:
procedure TFRM_Party.BTN_Party_BackClick(Sender: TObject);
begin
try
UniQuery.Connection.Close; // Closing Query connection
DB_Connection.Disconnect; // Disconnecting database
FreeAndNil(FRM_Party);
Close;
except
on E: Exception do
ShowMessage(E.Message);
end;
end;
Apart from the above code, nothing else is written on FRM_Party.
Now, the thing is that when I am running the application on mobile and opening/closing FRM_Party again and again, the first 4 times FRM_Party works very nice, but on the fifth time FRM_Party opens properly, but when closed the app hangs. I tried so many times by closing and opening the app. Every time the result is the same.
Can anyone help me?
In your OnActivate handler, your calls to BeginUpdate() and EndUpdate() on TABLEVIEW_Party are unbalanced if UniQuery.RecordCount is not exactly 1. You are calling BeginUpdate() before entering the loop, which is fine, but then you are calling EndUpdate() inside the loop, thus calling it a different number of times than you call BeginUpdate(). You need to move those calls to the same level, eg:
procedure TFRM_Party.FormActivate(Sender: TObject);
var
TableView : TTMSFMXTableViewItem;
I : Integer;
begin
if not Class_My_Pro_and_func.Func_DataBaseConnection then
Exit;
UniQuery.Close;
UniQuery.SQL.Text := 'select * from db_stock.tbl_party where Reg_ID = :Reg_ID and Party_Delete <> :Party_Delete order by Party_Name ';
UniQuery.ParamByName('Reg_ID').AsInteger := d_Glob_Reg_ID;
UniQuery.ParamByName('Party_Delete').AsString := 'F';
UniQuery.Open;
if UniQuery.RecordCount > 0 then
begin
TABLEVIEW_Party.BeginUpdate;
try
for I := 1 to UniQuery.RecordCount do
begin
TableView := TABLEVIEW_Party.Items.Add;
TableView.Caption := UniQuery.Fields[1].AsString;
TableView.Description := UniQuery.Fields[2].AsString + ' = ' + UniQuery.Fields[3].AsString;
UniQuery.Next;
end;
finally
TABLEVIEW_Party.EndUpdate;
end;
end
else
ShowMessage('No record Found.');
end;
Also, in your back button's OnClick handler, you are calling Close() on FRM_Party after calling FreeAndNil(FRM_Party).
On mobile platforms prior to RAD Studio 10.4, object lifetime is managed by ARC. Calling FreeAndNil(FRM_Party) will not actually free the FRM_Party object, it will simply set the FRM_Party variable to nil. The object is not freed because Application still has an active reference to it.
But in RAD Studio 10.4 onwards, ARC is no longer used, so calling FreeAndNil(FRM_Party) will actually destroy the object. So calling Close() after afterwards will crash your code.
The correct way to free a TForm when it is closed is to use its OnClose event instead, eg:
procedure TFRM_Party.FormDestroy(Sender: TObject);
begin
If FRM_Party = Self then
FRM_Party := nil;
end;
procedure TFRM_Party.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := TCloseAction.caFree;
end;
procedure TFRM_Party.BTN_Party_BackClick(Sender: TObject);
begin
UniQuery.Connection.Close;
DB_Connection.Disconnect;
Close;
end;
I'm developing application that is using Mifare Classic 1K card and HID Omnikey 5421 (successor of 5321). I using thread to detect card remove/insert.
Delphi code (thread method):
function CardWatcherThread(PContext: Pointer): integer;
var
RetVar : cardinal;
RContext : cardinal;
RStates : array[0..0] of SCARD_READERSTATEA;
begin
try
RContext := Cardinal(PContext^);
FillChar(RStates,SizeOf(RStates),#0);
RStates[0].szReader := SelectedReader;
RStates[0].pvUserData := nil;
RStates[0].dwCurrentState := SCARD_STATE_UNAWARE;
while ReaderOpen and (not Application.Terminated) do begin
RetVar := SCardGetStatusChange(RContext, MAX_WAIT_TIME_SCARDSTATUSCHANGE, #RStates, 1);
RStates[0].dwCurrentState := RStates[0].dwEventState;
ActReaderState := RStates[0].dwEventState;
// Avoid sedning error about timemout if MAX_WAIT_TIME_SCARDSTATUSCHANGE is not infinite
if (RetVar <> SCARD_E_TIMEOUT) or (MAX_WAIT_TIME_SCARDSTATUSCHANGE = -1) then begin
SendMessage(NotifyHandle, WM_CARDSTATE, RetVar, 0);
end;
end;
finally
Result := 0;
end;
end;
I'm using SendMessage to notify my Smart Card class where I'm detecting proper state. Also I automatically connect and read data from smart card when I detect card insertion.
My application is working correctly for most of the time, but sometimes for e.g. once in the 10000 of card insertion I'm getting SCARD_F_INTERNAL_ERROR from SCardGetStatusChange. When this happen SCardGetStatusChange is starting to result only SCARD_F_INTERNAL_ERROR all the time. When I detected this situation I tried to SCardCancel and SCardReleaseContext, end thread and establish new context and create new watcher thread with this new context but this is not helping because SCardGetStatusChange was continue to returning SCARD_F_INTERNAL_ERROR. Only when I close application and run again problem disappears.
It's happening randomly for me, I can't reproduce it using some known scenario. In PC can be more readers, but I'm establishing connection only to Omnikey 5421.
Someone met with this problem?
It's hard to say what goes wrong but I have few remarks about your code, hope they help...
you should check the return value of the SCardGetStatusChange as the first thing and if it is SCARD_E_TIMEOUT then just skip all the processing and start next cycle;
instead of just RStates[0].dwCurrentState := RStates[0].dwEventState; you also have to clear out the SCARD_STATE_CHANGED bit from the state (that is, if the state actually changed);
it is my understanding that the resource manager context might become invalid, so before calling SCardGetStatusChange use SCardIsValidContext to make sure you still have good context, if not acquire new one;
So try something like this (this is typed to the browser, so untestead and probably wont compile as is):
function CardWatcherThread(PContext: Pointer): integer;
var
RetVar : cardinal;
RContext : cardinal;
RStates : array[0..0] of SCARD_READERSTATEA;
begin
try
RContext := Cardinal(PContext^);
FillChar(RStates,SizeOf(RStates),#0);
RStates[0].szReader := SelectedReader;
RStates[0].pvUserData := nil;
RStates[0].dwCurrentState := SCARD_STATE_UNAWARE;
while ReaderOpen and (not Application.Terminated) do begin
if(SCardIsValidContext(RContext) <> SCARD_S_SUCCESS)then begin
RetVal := SCardEstablishContext(...);
end;
RetVar := SCardGetStatusChange(RContext, MAX_WAIT_TIME_SCARDSTATUSCHANGE, #RStates, 1);
case RetVal of
SCARD_E_TIMEOUT:;
SCARD_S_SUCCESS: begin
if((RStates[0].dwEventState and SCARD_STATE_CHANGED) <> 0)then begin
RStates[0].dwCurrentState := RStates[0].dwEventState xor SCARD_STATE_CHANGED;
// reader's state changed, do something
end;
end;
end;
end;
finally
Result := 0;
end;
end;
i have the current scenario, im using omnithreadlibrary for some generic background work like this:
TMethod = procedure of object;
TThreadExecuter = class;
IPresentationAnimation = interface
['{57DB6925-5A8B-4B2B-9CDD-0D45AA645592}']
procedure IsBusy();
procedure IsAvaliable();
end;
procedure TThreadExecuter.Execute(AMethod: TMethod); overload;
var ATask : IOmniTaskControl;
begin
ATask := CreateTask(
procedure(const ATask : IOmniTask) begin AMethod(); end
).OnTerminated(
procedure begin ATask := nil; end
).Unobserved().Run();
while Assigned(ATask) do
begin
Sleep(10);
Application.ProcessMessages;
end;
end;
procedure TThreadExecuter.Execute(ASender: TCustomForm; AMethod: TMethod); overload;
var AAnimator : IPresentationAnimation;
begin
if(Assigned(ASender)) then
begin
TInterfaceConsolidation.Implements(ASender, IPresentationAnimation, AAnimator, False);
if(Assigned(AAnimator)) then AAnimator.IsBusy()
else ASender.Enabled := False;
end;
try
Self.Execute(AMethod);
finally
if(Assigned(ASender)) then
begin
if(Assigned(AAnimator)) then AAnimator.IsAvaliable()
else ASender.Enabled := True;
end;
end;
end;
so before i start executing i block the interface like this:
TMyForm = class(TForm, IPresentationAnimation);
procedure TMyForm.LoadData();
begin
TThreadExecuter.Execute(Self, Self.List);
end;
procedure TMyForm.IsBusy();
begin
try
Self.FWorker := TPresentationFormWorker.Create(Self);
Self.FWorker.Parent := Self;
Self.FWorker.Show();
finally
Self.Enabled := False;
end;
end;
and when the thread finish i release the block like this:
procedure TMyForm.IsAvaliable();
begin
try
Self.FWorker.Release();
finally
Self.Enabled := True;
end;
end;
note: TPresentationFormWorker is a animated form that i put in form of the busy one.
the problem is that when the form is "busy" executing the thread even after i disable it, i can still interact with him, for example:
i can click in any button and when the thread finish the execution the action of the button are triggered;
i can typing in any control, e.g a Edit some nonsense information and when the thread finish the execution the content i provided to the control are erased back to before (ui rollback? lol);
so my guess is that while the thread are working thanks to the application.processmessages the interaction i made to the disable form are sended to the queue and once the thread finish they are all send back to the form.
my question is: is possible to actually disable the form, when i say disable i mean block all messages until certain point that i manually allow that can start accept again?
thx in advance.
What is good way to implement long running queries on IdHttpServer. I have written simple logic to do so, please advise suggest better way to achive the same as I'm struggling with its performance.
I am using D2010 and Indy 10.5.8 to achieve the goal, also suggest if we retrive values frequently from session will that be a resource intensive ?
procedure TForm1.ServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
SessionObj : TSessionData;
begin
if ARequestInfo.Document = 'EXECUTEQUERY' then
begin
if not Assigned(ARequestInfo.Session.Content) then
begin
SessionObj := TSessionData.Create;
ARequestInfo.Session.Content.AddObject('U_SESSION', SessionObj);
SessionObj.RunLongQuery;
end;
end;
if ARequestInfo.Document = 'GETDATA' then
begin
SessionObj := TSessionData(ARequestInfo.Session.Content.Objects[ ARequestInfo.Session.Content.IndexOf('U_SESSION')]);
if SessionObj.GetQueryStat = Done then
begin
AResponseInfo.ContentStream.CopyFrom(SessionObj.GetMemStream, SessionObj.GetMemStream.Size);
SessionObj.GetMemStream.Clear;
AResponseInfo.ResponseNo := 200;
end else if SessionObj.GetQueryStat = Error then
AResponseInfo.ResponseNo := 500
else AResponseInfo.ResponseNo := 102;
end;
end;
procedure TForm1.ServerSessionEnd(Sender: TIdHTTPSession);
begin
TSessionData(Sender.Content.Objects[ Sender.Content.IndexOf('U_SESSION')]).Free;
end;
{ TProcessQuery }
constructor TProcessQuery.Create;
begin
myConn := TMyConnection.Create(nil);
myConn.LoginPrompt := False;
myConn.UserName := 'UserName';
myConn.Password := 'Password';
myConn.Server := 'Host';
myConn.Database := 'DBName';
myConn.Connected := True;
myQuery := TMyQuery.Create(nil);
myQuery.Unidirectional := True;
myQuery.Options.CreateConnection := False;
myQuery.Connection := myConn;
Fstat := None;
Fstream := TMemoryStream.Create;
end;
destructor TProcessQuery.Destroy;
begin
if Assigned(myConn) then begin
myConn.Close;
myConn.Disconnect;
FreeAndNil(myConn);
end;
end;
procedure TProcessQuery.ExecuteQuery;
begin
Status := Started;
myQuery.SQL.Text := '<Some Query>';
myQuery.Open;
try
try
while not myQuery.Eof do
begin
Status := Inprogress;
//Add to FStream which would be returned to user.
end;
except
on Exception do
Status := Error;
end;
finally
myQuery.Close;
end;
end;
{ TSessionData }
constructor TSessionData.Create;
begin
FProcessQuery := TProcessQuery.Create;
end;
function TSessionData.GetMemStream: TMemoryStream;
begin
result := FProcessQuery.Fstream;
end;
function TSessionData.GetQueryStat: TStatus;
begin
result := FProcessQuery.Status;
end;
procedure TSessionData.RunLongQuery;
begin
FProcessQuery.ExecuteQuery
end;
You are running the actual query in the context of ServerCommandGet(), so the client will not receive a reply until the query has finished. For what you are attempting, you need to move the query to its own thread and let ServerCommandGet() exit so the client gets a reply and can move on, thus freeing it to send subsequent GETDATA requests. In ServerSessionEnd(), you will have to terminate the query thread if it is still running, and free the TSessionData object.
There are some other problems with your code as well.
ServerCommandGet() is checking for not Assigned(ARequestInfo.Session.Content) and then calling ARequestInfo.Session.Content.AddObject() when ARequestInfo.Session.Contentis nil. I don't see any code that is creating the ARequestInfo.Session.Content object.
If the client issues multiple EXECUTEQUERY requests, you are storing them all in AResponseInfo.Session.Content using the same name, 'U_SESSION'. GETDATA will return the results of only the first query it finds, and ServerSessionEnd() only frees the first query it finds. So either give each query a unique name and send that back to the client so it can include it in GETDATA and make ServerSessionEnd() loop through the entire Sender.Content, or else do not allow multiple queries in the same HTTP session. If the client issues a new EXECUTEQUERY while a previous query is still active, kill the previous query before starting the new one.
When the client issues GETDATA, the code needs to take into account that the requested query may not exist, such as if it previously expired and was freed by ServerSessionEnd(). Also, if a query does exist and has finished, you are calling AResponseInfo.ContentStream.CopyFrom() but AResponseInfo.ContentStream is nil when ServerCommandGet() is called. You are responsible for providing your own ContentStream object. So either take ownership of TSessionData's memory stream and assign it as the AResponseInfo.ContentStream object, or else create a new TMemoryStream to copy into and then assign that as the AResponseInfo.ContentStream object. Either way, TIdHTTPServer will free the AResponseInfo.ContentStream after sending it to the client.