i'm trying to develop a application that runs a stored procedure in a background mode.
1 - If i run in the mains thread, it's OK, it's lock the screen.
2 - If i put the stpGen.ExecProc; in a thread, it's runs OK, but it's lock the mains thread too.
is there a option to run TStoredProc in a thread and don't lock the main thread?
Code:
type
TStoredProcSegundoPlano = class(TThread)
private
stpGen: TStoredProc;
excErro: Exception;
protected
procedure Execute; override;
public
constructor Create(const stpGen: TStoredProc; const blnAutoFree, blnAutoStart: Boolean);
property Erro: Exception read excErro;
end;
implementation
{ TStoredProcSegundoPlano }
constructor TStoredProcSegundoPlano.Create(const stpGen: TStoredProc;
const blnAutoFree, blnAutoStart: Boolean);
begin
inherited Create(True);
Self.excErro := nil;
Self.stpGen := stpGen;
if blnAutoFree then
FreeOnTerminate := True;
if blnAutoStart then
Resume;
end;
procedure TStoredProcSegundoPlano.Execute;
begin
try
try
stpGen.ExecProc;
except
on E: Exception do
begin
excErro := AcquireExceptionObject;
end;
end;
finally
Terminate;
end;
end;
so, i call this way:
TStoredProcSegundoPlano.Create(stpGen, True, True);
in this moment, the application is ok, but few seconds after, the maisn threads lock, i don't have any idea know to resolve this, it's possivel to run a TStoredProc un a background?
Thanks
Related
Hi I'm doing a code MessageDlgPos running five threads at the same time, the code is this:
type
TMyThread = class(TThread)
protected
procedure Execute; override;
public
text: string;
property ReturnValue;
end;
procedure TMyThread.Execute;
begin
if Terminated then
Exit;
MessageDlgPos(text, mtInformation, [mbOk], 0, 100, 200);
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
LThread: TMyThread;
i: Integer;
begin
For i := 1 to 5 do
begin
LThread := TMyThread(Sender);
try
LThread.text := 'hi';
LThread.FreeOnTerminate := True;
except
LThread.Free;
raise;
end;
LThread.Resume;
end;
end;
The problem is that Delphi XE always returns the following error and does not execute anything:
First chance exception at $ 7524B727. Exception class EAccessViolation with message 'Access violation at address 00D0B9AB. Write of address 8CC38309 '. Process tester.exe (6300)
How do I fix this problem?
As David Heffernan pointed out, MessageDlgPos() cannot safely be called outside of the main UI thread, and you are not managing the thread correctly. Your code needs to look more like this instead:
type
TMyThread = class(TThread)
protected
procedure Execute; override;
public
text: string;
property ReturnValue;
end;
procedure TMyThread.Execute;
begin
// no need to check Terminated here, TThread already
// does that before calling Execute()...
TThread.Synchronize(nil,
procedure
begin
MessageDlgPos(text, mtInformation, [mbOk], 0, 100, 200);
end
);
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
LThread: TMyThread;
i: Integer;
begin
For i := 1 to 5 do
begin
LThread := TMyThread.Create(True);
LThread.text := 'hi';
LThread.FreeOnTerminate := True;
LThread.Start;
end;
end;
I would suggest a slightly different variation:
type
TMyThread = class(TThread)
private
fText: string;
protected
procedure Execute; override;
public
constructor Create(const aText: string); reintroduce;
property ReturnValue;
end;
constructor TMyThread.Create(const aText: string);
begin
inherited Create(False);
FreeOnTerminate := True;
fText := aText;
end;
procedure TMyThread.Execute;
begin
// no need to check Terminated here, TThread already
// does that before calling Execute()...
TThread.Synchronize(nil,
procedure
begin
MessageDlgPos(fText, mtInformation, [mbOk], 0, 100, 200);
end
);
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
i: Integer;
begin
For i := 1 to 5 do
begin
TMyThread.Create('hi');
end;
end;
But either way, if you don't like using TThread.Synchronize() to delegate to the main thread (thus only displaying 1 dialog at a time) then you cannot use MessageDlgPos() at all, since it is only safe to call in the main UI thread. You can use Windows.MessageBox() instead, which can be safely called in a worker thread without delegation (but then you lose the ability to specify its screen position, unless you access its HWND directly by using a thread-local hook via SetWindowsHookEx() to intercept the dialog's creation and discover its HWND):
procedure TMyThread.Execute;
begin
Windows.MessageBox(0, PChar(fText), PChar(Application.Title), MB_OK or MB_ICONINFORMATION);
);
end;
There are many problems. The biggest one is here:
LThread := TMyThread(Sender);
Sender is a button. Casting to a thread is simply wrong and the cause of your exception. Casting a button to a thread doesn't make it so. It's still a button.
You likely mean to create a thread instead.
LThread := TMyThread.Create(True);
You cannot show VCL UI outside the main thread. The call to MessageDlgPos breaks that rule. If you do need to show UI at that point, you'll need to use TThread.Synchronize to have the code execute in the main thread.
Your exception handler makes no sense to me. I think you should remove it.
Resume is deprecated. Use Start instead.
I have multithreaded app and I have a question regarding assigning objects between threads and how to lock them properly.
I defined custom type class and in main thread I create an instance of that type. I would like to assign different objects to a thread, those objects will be used within Execute method of a thread.
type TMyClass = class
private
FData: Integer;
public
property Data: Integer read FData write FData;
end;
TMyThread = class(TThread)
private
FMyObject: TMyObject;
FLock: TCriticalSection;
protected
procedure Execute; override;
public
procedure Lock;
procedure Unlock;
property MyObject: TMyObject read FMyObject write FMyObject;
end;
procedure TMyThread.Lock;
begin
FLock.Acquire;
end;
procedure TMyThread.Unlock;
begin
FLock.Release;
end;
procedure TMyThread.Execute;
begin
while not Terminated do
begin
Lock;
try
if Assigned(FMyObject) then
FMyObject.Data := FMyObject.Data + 1;
finally
Unlock;
end;
end;
end;
from main thread:
var MyObject1, MyObject2: TMyObject;
thOperation: TMyThread;
CurrData1, CurrData2: Integer;
begin
// create two objects
MyObject1 := TMyObject.Create;
MyObject2 := TMyObject.Create;
// create thread(started)
thOperation := TMyThread.Create(false);
thOperation.Lock;
try
thOperation.MyObject := MyObject1;
finally
thOperation.Unlock;
end;
/// .... do some stuff in main thread
thOperation.Lock;
try
CurrData1 := thOperation.MyObject.Data;
finally
Unlock;
end;
// let's assign new object on a running thread
thOperation.Lock;
try
thOperation.MyObject := MyObject2;
finally
thOperation.Unlock;
end;
/// .... do some stuff in main thread again
thOperation.Lock;
try
CurrData2 := thOperation.MyObject.Data;
finally
Unlock;
end;
if CurrData1 <> CurrData2 then ShowMessage('Different result!');
// do cleanup
thOperation.Terminate;
thOperation.WaitFor;
thOperation.Free;
MyObject1.Free;
MyObject2.Free;
end;
Is this approach of locking when assigning different objects to a thread ok?
To answer your question, yes, your approach of using TCriticalSection is ok.
For more information on multithreading, in case you don't have it yet, Google for 'Multithreading - The Delphi way' by Martin Harvey. An excellent article (or should I say book).
I am using the following (pseudo)code in Free Pascal to allow access to a COM object in multithreaded applications:
type
TCoObjectInstance = record
ThreadID: TThreadID;
CoObject: TLB.CoObject;
end;
type
TCoObjectWrapper = class(...)
strict private
FCoObjectInstance: array[0..9] of TCoObjectInstance;
public
constructor Create; override;
destructor Destroy; override;
procedure InitializeThread;
procedure LeaveThread;
function CoInstance: MyCoInstance;
procedure UseCoInstance;
//...
end;
var
MyOneCoObjectWrapper: TOneCoObjectWrapper;
type
TDoSomethingThread = class(TThread)
protected
procedure Execute; override;
public
Finished: boolean;
// ...
end;
// TDoSomethingThread
procedure TDoSomethingThread.Execute;
begin
MyOneCoObjectWrapper.InitializeThread;
while (not Terminated) do
begin
MyOneCoObjectWrapper.UseCoInstance;
Sleep(100);
end;
MyOneCoObjectWrapper.LeaveThread; // <--------------- !!!
end;
Finished := True;
end;
// TCoObjectWrapper
constructor TCoObjectWrapper.Create;
begin
// ...
OleCheck(CoInitializeEx(nil, COINIT_APARTMENTTHREADED));
FCoObjectInstances[0].ThreadID := GetThreadID;
FCoObjectInstances[0].CoObject := CoObject.Create;
GIT.RegisterInterfaceInGlobal(FCoObjectInstances[0].CoObject, TLB.CoObject, CoInterfaceMarshalCookie);
// ...
end;
destructor TCoObjectWrapper.Destroy;
begin
// ...
CoUninitialize;
// ...
end;
procedure TCoObjectWrapper.InitializeThread;
var
i: integer;
begin
OleCheck(CoInitializeEx(nil, COINIT_APARTMENTTHREADED));
// Find next free instance
i := Low(FCoObjectInstances) + 1;
while Assigned(FCoObjectInstances[i].CoObject) and (i <= High(FCoObjectInstances)) do
Inc(i);
if (i > High(FCoObjectInstances)) then
raise Exception.Create('Ran out of instances in InitializeThread!');
GIT.GetInterfaceFromGlobal(CoInterfaceMarshalCookie, TLB.CoObject, FCoObjectInstances[i].CoObject);
FCoObjectInstances[i].ThreadID := GetThreadID;
end;
procedure TCoObjectWrapper.LeaveThread;
var
i: integer;
begin
i := Low(FCoObjectInstances) + 1;
while (FCoObjectInstances[i].ThreadID <> GetThreadID) and (i <= High(FCoObjectInstances)) do
Inc(i);
if (i > High(FCoObjectInstances)) then
raise ELogged.Create('Instance not found');
FCoObjectInstances[i].ThreadID := 0;
FCoObjectInstances[i].CoObject := nil;
CoUninitialize; // <----- !
end;
function TCoObjectWrapper.CoInstance: TLB.CoObject;
var
i: integer = Low(FCoObjectInstances);
begin
Result := nil;
while (not Assigned(Result)) and (i <= High(FCoObjectInstances)) do
begin
if (FCoObjectInstances[i].ThreadID = GetThreadID) then
Result := FCoObjectInstances[i].CoObject;
Inc(i);
end;
if not Assigned(Result) then
raise Exception.Create('Instance not found');
end;
procedure TCoObjectWrapper.UseCoInstance;
begin
// Do somthing with the COM object
end;
This is supposed to work as follows:
In FormCreate (main thread), a global instance of TCoObjectWrapper (MyOneCoObjectWrapper)
is created
Methods of MyOneCoObjectWrapper are called from the main thread, accessing the encapsulated COM object
From the main thread, an instance of TDoSomethingThread is created. Once the thread is started, it initializes it's COM via calling MyOneCoObjectWrapper.IntitializeThread
The main thread and the subthread access the COM object
Upon Termination of the thread, MyOneCoObjectWrapper.LeaveThread is called to finalize COM for this thread (THIS IS WHERE THINGS GET STUCK - see below)
Some more use of the COM object by the main thread
In FormDestroy (main thread), the global instance of TCoObjectWrapper is destroyed and COM for the main thread is finalized in TCoObjectWrapper.Destroy
My questions are:
Code-wise, is this a completely dumb way to approach this problem?
It works very well, both from the main thread as well as from the subthreads. The only problem is that very often, TCoObjectWrapper.LeaveThread hangs at CoUninitialize and the program freezes. Is there any explanation for this behaviour, how can I analyse that further?
Thanks!
I have a TButton in the main TForm. When user click the button, it will execute the below process:
begin
Process_done := FALSE;
Process_Result.Clear;
cmdProcess.CommandLine := #34+AppPath+'getdata.exe"';
cmdProcess.Run;
Repeat
Application.ProcessMessages;
Until Process_done;
end;
As you can see above, the process calls external executable, and the process can take some times which blocking the main application.
This is only one process, and I need another one.
So, I am thinking to implement multi-threading, where I can run the above process in a separate thread. The other process as well. And the main thread can do something WHILE checking when both processes done.
Can anyone give me some examples how to do this using Delphi 7?
OR point me to an article, simple implementation like this?
Thanks.
Try something like this:
type
TRunProcessThread = class(TThread)
protected
cmdProcess: Whatever;
procedure Execute; override;
public
constructor Create(const ACmdLine: String);
destructor Destroy; override;
end;
constructor TRunProcessThread.Create(const ACmdLine: String);
begin
inherited Create(True);
FreeOnTerminate := True;
cmdProcess := Whatever.Create;
cmdProcess.CommandLine := ACmdLine;
end;
destructor TRunProcessThread.Destroy;
begin
cmdProcess.Free;
inherited;
end;
procedure TRunProcessThread.Execute;
begin
cmdProcess.Run;
...
end;
.
procedure TForm1.Button1Click(Sender: TObject);
var
Thread: TRunProcessThread;
begin
Thread := TRunProcessThread.Create(AnsiQuotedStr(AppPath + 'getdata.exe', #34));
Thread.OnTerminate := ProcessDone;
Thread.Resume;
end;
procedure TForm1.ProcessDone(Sender: TObject);
begin
// access TRunProcessThread(Sender) to get result information as needed ...
end;
You should create a class inherited from TThread and put that code in there. I don't remember exactly, but I think you'll find TThread template in File->New dialog box. When code execution is finished, you just notify your gui. Here's an article how to synchronize UI with external thread http://delphi.about.com/od/kbthread/a/thread-gui.htm
I have created a class that derives from TThread, because I wish to do some async stuff, however to avoid having to create another class, I built the entire thing around that thread class. Not sure if this is good practice or not, and if I cant get this to work, well then I suppose I have no choice but to recode..
The problem: I create the Thread on FormCreate, assign some properties, and I Free it on FormDestroy. In the Thread's constructor, I set FreeOnTerminate = False. When I click on a button on my Form, I Start(); the Thread. Okay, so it runs as expected, an error occurs (expected!), its being passed to my error handling event, and it appears to terminate. I then click the button again, and I get a Cannot call Start on a running or suspended thread error.
How can I finish the thread without freeing it, and enabling me to start it again?
You can't restart a thread once it is finished/terminated. In that case you should just create a new instance if the thread again like you did in FormCreate.
Catch the error in the thread, handle it there and then let the thread continue the work. To handle the error you could simply queue a method to the main thread to report the error, for example. I hope you aren't letting exceptions leave your thread Execute method.
This is the way that I implement it:
procedure TAPIRequest.DoRequest;
begin
FBusy := True;
Resume;
end;
procedure TAPIRequest.Execute;
begin
inherited;
while not Terminated do begin
HttpError := False;
try
Response := HTTP.Post(URL, Params);
ParseResponse;
except
HttpError := True;
end;
if Assigned(OnResponse) then
OnResponse();
FBusy := False;
Suspend;
end;
end;
type
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
var
Form1: TForm1;
MyThread: TMyThread;
Event: TEvent;
procedure TForm1.FormCreate(Sender: TObject);
begin
Event := TEvent.Create(nil,true,false, '');
MyThread := TMyThread.Create(False);
end;
procedure TMyThread.Execute;
begin
while True do
begin
Event.WaitFor(Infinite);
// do something
Event.ResetEvent;
end;
end;
procedure RestartThread;
begin
Event.SetEvent;
// if you need check thread status, wait or run, use here
// if Event.WaitFor(0) = ...(wrTimeout, wrSignaled)
end;