How can i use TComport, from inside a thread (e.g OTL or Jedi Thread) to catch incoming strings? What the "SyncMethod" of TComport actually does?
This is my code:
procedure TForm5.ComPort1RxChar(Sender: TObject; Count: Integer);
var
Str:string;
commapos:integer;
begin
ComPort1.ReadStr(Str, Count);
commapos:=System.Pos(',',str);
if (commapos>0) then
// Do Something
else
// Do Something else
end;
The above question can be implemented via TurboPower Async Pro with better resaults?
Thanks in advance.
P.S. It is a must to read incoming strings from a ComPort using a background worker.
Related
I am new with this stuff of Threading in Delphi. so, I am trying to make a simple query aplication that make a bit call up for the database and take a bit of time, so I want to alert the user that there is a background process and have to be patient.
I tried many samples, but none of them work for me, Please, could somebody show me a simple sample that could work?
I know that I have to Declare a Type of TThread, with Create and Override Execute... etc.. but since that I am lost...
Using Delphi 7, SQL Server 2005 and ADO, Windows XP sp3.-
Thanks.
Yup, you declare a new type which inherits from TThread:
TMyWorkerThread = class(TThread)
end;
Then you add a function override for Execute():
TMyWorkerThread = class(TThread)
public
procedure Execute; override;
end;
That procedure will be called when you start your thread. It will be executed in parallel with your main program. Let's write it.
procedure TMyWorkerThread.Execute;
begin
//Here we do work
DoSomeWork();
DoMoreWork();
//When we exit the procedure, the thread ends.
//So we don't exit until we're done.
end;
How to use this? Let's say you want to start doing work when the user clicks button. You write an OnClick handler:
procedure TMainForm.Button1Click(Sender: TObject);
begin
TMyWorkerThread.Create(false);
end;
That's it. After the user clicks button, your thread starts and proceeds with doing whatever it is that you wrote in Execute. If the user clicks the button again, another thread will start, and then another - one every click. They will all run in parallel, each doing all what's written in Execute() and then ending.
Let's say you want to check if the work is over. For that, you'll have to store the reference to your thread somewhere:
TMainForm = class(TForm)
{...skipped...}
public
MyWorkerThread: TThread;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
//This time we make sure only one thread can be started.
//If one thread have been started already, we don't start another.
if MyWorkerThread<>nil then
raise Exception.Create('One thread have already been started!');
MyWorkerThread := TMyWorkerThread.Create(false);
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
//If the work is not over yet, we display message informing the user we're still working
if (MyWorkerThread<>nil) and (WaitForSingleObject(MyWorkerThread.Handle, 0)<>WAIT_OBJECT_0) then
MessageBox(Self.Handle, pchar("The work is not yet done!"), pchar("Still running"), MB_OK);
end;
As you see, we're checking if a thread is still running by calling a Windows function called WaitForSingleObject. This function waits until the thread is done working, or the timeout is elapsed, and as we specify the timeout of 0, it just exists immediately if the thread is not over yet.
You can find many examples on the web of threads. The only special feature, if you are using ADO connections inside the Thread, is that you can't share the same connection.
Each thread must create its own connection, otherwise they are equal (should follow the same rules as any other thread.)
An sample that I have used is this:
TADOSQLThread = class(TThread)
private
FADOQ: TADOQuery; // Internal query
FSQL: string; // SQL To execute
FID: integer; // Internal ID
public
constructor Create(CreateSuspended:Boolean; AConnString:String;
ASQL:string; IDThread:integer);
destructor Destroy; override;
procedure Execute(); override;
property ID:integer read FID write FID;
property SQL:string read FSQL write FSQL;
property ADOQ:TADOQuery read FADOQ write FADOQ;
end;
The Create constructor is overrided, and look like this:
constructor TADOSQLThread.Create(CreateSuspended:Boolean; AConnString:String;
ASQL:string; IDThread:integer);
begin
inherited Create(CreateSuspended);
// ini
Self.FreeOnTerminate := False;
// Create the Query
FADOQ := TAdoquery.Create(nil);
// assign connections
FADOQ.ConnectionString := AConnString;
FADOQ.SQL.Add(ASQL);
Self.FID := IDThread;
Self.FSQL:= ASQL;
end;
And the execute method is very simple:
procedure TADOSQLThread.Execute();
begin
inherited;
try
// Ejecutar la consulta
Self.FADOQ.Open;
except
// Error al ejecutar
...Error treattement
end;
end;
To start and create a thread you can use code similar to this:
//crear el Thread
th := TADOSQLThread.Create(True, mmConnection.Lines.Text, ASQL, AId);
// internal for me (for controled the number of active threads and limete it)
inc(numThreads);
// evento finalizacion
th.OnTerminate := TerminateThread;
// Ejecutarlo
th.Resume;
I have create a TerminateThread method that receive the control of threads when they finish. The only different to other threads is the connection problem. You must create a new connection on every thread, It can't share the same ADOConnections with others.
I hope this example will be useful for you.
Regards
I’m writing a simple Windows TCP/IP server application, which only needs to communicate with one client at a time. My application has four threads:
Main program which also handles transmission of data as needed.
Receive incoming data thread.
Listen thread to accept connection requests from the client.
A ping thread which monitors everything else, and transmits heartbeat messages as needed. I realise that the latter shouldn’t really be necessary with TCP/IP, but the client application (over which I have no control) requires this.
I’ve confirmed in task manager that my application does indeed have four threads running.
I’m using blocking TCP/IP sockets, but my understanding is that they only block the calling thread – the other threads should still be allowed to execute without being blocked. However, I have encountered the following issues:
If the ping thread deems the connection to have died, it calls closesocket(). However, this appears to be being blocked by the call to recv() in the receive thread.
The main application is unable to transmit data while the receive thread has a call to recv() in progress.
The socket is being created via the accept() function. At this stage I’m not setting any socket options.
I've now created a simple two thread program which illustrates the problem. Without the WSA_FLAG_OVERLAPPED flag, the second thread gets blocked by the first thread, even though this would appear to be contrary to what is supposed to happen. If the WSA_FLAG_OVERLAPPED flag is set, then everything works as I would expect.
PROJECT SOURCE FILE:
====================
program Blocking;
uses
Forms,
Blocking_Test in 'Blocking_Test.pas' {Form1},
Close_Test in 'Close_Test.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end. { Blocking }
UNIT 1 SOURCE FILE:
===================
unit Blocking_Test;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, WinSock2;
type
TForm1 = class(TForm)
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Test_Socket: TSocket;
Test_Addr: TSockAddr;
wsda: TWSADATA; { used to store info returned from WSAStartup }
implementation
{$R *.dfm}
uses
Debugger, Close_Test;
procedure TForm1.FormShow(Sender: TObject);
const
Test_Port: word = 3804;
var
Buffer: array [0..127] of byte;
Bytes_Read: integer;
begin { TForm1.FormShow }
Debug('Main thread started');
assert(WSAStartup(MAKEWORD(2,2), wsda) = 0); { WinSock load version 2.2 }
Test_Socket := WSASocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP, nil, 0, 0{WSA_FLAG_OVERLAPPED});
assert(Test_Socket <> INVALID_SOCKET);
with Test_Addr do
begin
sin_family := AF_INET;
sin_port := htons(Test_Port);
sin_addr.s_addr := 0; { this will be filled in by bind }
end; { with This_PC_Address }
assert(bind(Test_Socket, #Test_Addr, SizeOf(Test_Addr)) = 0);
Close_Thread := TClose_Thread.Create(false); { start thread immediately }
Debug('B4 Rx');
Bytes_Read := recv(Test_Socket, Buffer, SizeOf(Buffer), 0);
Debug('After Rx');
end; { TForm1.FormShow }
end. { Blocking_Test }
UNIT 2 SOURCE FILE:
===================
unit Close_Test;
interface
uses
Classes;
type
TClose_Thread = class(TThread)
protected
procedure Execute; override;
end; { TClose_Thread }
var
Close_Thread: TClose_Thread;
implementation
uses
Blocking_Test, Debugger, Windows, WinSock2;
type
TThreadNameInfo = record
FType: LongWord; // must be 0x1000
FName: PChar; // pointer to name (in user address space)
FThreadID: LongWord; // thread ID (-1 indicates caller thread)
FFlags: LongWord; // reserved for future use, must be zero
end; { TThreadNameInfo }
var
ThreadNameInfo: TThreadNameInfo;
procedure TClose_Thread.Execute;
procedure SetName;
begin { SetName }
ThreadNameInfo.FType := $1000;
ThreadNameInfo.FName := 'Ping_Thread';
ThreadNameInfo.FThreadID := $FFFFFFFF;
ThreadNameInfo.FFlags := 0;
try
RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), #ThreadNameInfo );
except
end; { try }
end; { SetName }
begin { TClose_Thread.Execute }
Debug('Close thread started');
SetName;
sleep(10000); { wait 10 seconds }
Debug('B4 Close');
closesocket(Test_Socket);
Debug('After Close');
end; { TClose_Thread.Execute }
end. { Close_Test }
P.S. Since setting the WSA_FLAG_OVERLAPPED attribute has fixed the problem, I've posted the above for academic interest.
If the ping thread deems the connection to have died, it calls closesocket(). However, this appears to be being blocked by the call to recv() in the receive thread.
That's just a bug in your code. You cannot free a resource in one thread while another thread is, or might be, using it. You will have to arrange some sane way to ensure that you don't create race conditions around access to the socket.
To be clear, there is no way you can know what that kind of code could possibly do. For example, consider:
The thread actually hasn't called recv yet, it's about to call recv but the scheduler hasn't got around to it yet.
The other thread calls closesocket.
A thread that is part of a system library opens a new socket and happens to get the same socket descriptor you just closed.
Your thread now gets to call recv, only it's receiving on the socket the library opened!
It is your responsibility to avoid these kinds of race conditions or your code will behave unpredictably. There's no way you can know what the consequence of performing random operations on random sockets could be. So you must not release a resource in one thread while another thread is, might be, or (worst of all) might be about to be, using it.
Most likely what's actually happening is that Delphi has some kind of internal synchronization that is trying to save you from disaster by blocking the thread that can't safely make forward progress.
UPDATE: accept() creates the new socket with the same attributes as the socket used for listening. Since I hadn’t set the WSA_FLAG_OVERLAPPED attribute for the listen socket, this attribute wasn’t being set for the new socket, and options like the receive timeout didn’t do anything.
Setting the WSA_FLAG_OVERLAPPED attribute for the listen socket seems to have fixed the problem. Thus I can now use the receive timeout, and the Ping thread no longer needs to close the socket if no data has been received.
Setting the WSA_FLAG_OVERLAPPED attribute for the listen socket also seems to have addressed the blocking other threads issue.
I'm using XE8 and I'm trying to built an example of my real world application.
I need to communicate between the main "service thread" and the OTL thread pool.
The examples are all set with forms and Monitors. I don't need those, but I can't figure out a way to write a clean code. So far this is what I did:
TProcessWorker = Class( TOmniWorker )
strict private
FTaskID : int64;
FIndex : Integer;
FFolder : String;
protected
function Initialize: Boolean; override;
public
procedure WriteTask( var msg : TMessage); message _AM_WriteTask;
End;
{ TProcessWorker }
function TProcessWorker.Initialize: Boolean;
begin
FTaskID := Task.UniqueID;
FIndex := 0;
result := True;
FFolder := Format('%s/%d', [Task.Param['Folder'].AsString, FTaskID]);
ForceDirectories(FFolder);
end;
Implemented as:
procedure TProcessWorker.WriteTask(var msg: TMessage);
var
ps : PString;
L : TStringStream;
begin
Ps:= PString(msg.LParam);
L := TStringStream.Create( ps^ );
try
L.SaveToFile( format('%s\%d.txt',[FFolder, fIndex]) );
finally
l.Free;
inc(FIndex);
end;
end;
In the main thread, to create the pool, I'm calling:
FThreadPool := CreateThreadPool('Thread pool test');
and
var
lFolder : String;
Process : IOmniWorker;
begin
lFOlder := ExtractFilePath(ParamStr(0));
Process := TProcessWorker.Create;
CreateTask( Process, 'Task test').Unobserved.SetParameter('Folder',lFolder).Schedule(FThreadPool);
I don't know how to call correctly my worker thread. In my real application, several thread will be triggered and I need to be sure I using correctly the threadpool.
1) By calling CreateTask as I am, how am I making a correct use of threadpool? It's seems odd to me to call CreateTask for every Process I need.
2) The worker thread is never triggered. How should I make my Worker thread work! :)
Regards,
Clément
OmniThreadLibrary test 08_RegisterComm shows how to communicate directly between two threads.
Basically, you have to create an instance of IOmniTwoWayChannel and register its endpoint in the worker's Initialize method with Task.RegisterComm(<channel>).
You can then send messages in a 'normal' way with <channel>.Send(<message>, <data>) and they will be dispatched to other task's message method if you decorate it in a Delphi way:
procedure MessageHandler(var msg: TOmniMessage); message <message>;
check http://otl.17slon.com/book/doku.php?id=book:howto:connectionpool
my feeling is that OTL is based upon data containers, not threads.
so I think you need to make a queue of task requests that your "main thread" would inject tasks into.
the idea of pools is that they manage themselves! you should not communicate with a specific worker thread, you should just sent work requests into it, and then let the pool spawn/kill worker threads as it sees fit.
if you need feedback from every specific thread, I'd rather include TForm.Handle or maybe the TOmniMonitor pointer into the task request record, and make the worker thread to call back and communicate with the form, no the from with the thread
Okay guys, I'm using TClientSocket class and Threads to work simultaneously with a list of hosts. It's all good but I started note that after sometime, all threads get stucked into a ReceiveBuf call... If I open 10 threads, to check 100 hosts for example, it will start good, but after sometime all threads will be stucked because for some reason some hosts don't answer fine for this ReceiveBuf call... I tried to do a ReceiveLength and check if receive > 0, to call the ReceiveBuf, but still not working.
I'll post the original code below:
function Threads.ReceiveProtocolVersion;
var
ProtocolVersion: array[0..11] of AnsiChar;
begin
try
MySocket.Socket.ReceiveBuf(ProtocolVersion, SizeOf(ProtocolVersion));
Version:= AnsiString(ProtocolVersion);
...//continues but doesn't matter because many threads get stucked in the ReceiveBuf call...
except
Terminate; //we terminate thread if raise some exception..
Ok, so after some researchs, I started tryin to do like this:
function Threads.ReceiveProtocolVersion;
var
ProtocolVersion: array[0..11] of AnsiChar;
SizeBuf: integer;
begin
try
SizeBuf:= MySocket.Socket.ReceiveLength;
if SizeBuf > 0 then
begin
MySocket.Socket.ReceiveBuf(ProtocolVersion, SizeOf(ProtocolVersion));
Version:= AnsiString(ProtocolVersion);
....
end;
except
Terminate; //we terminate thread if raise some exception..
Apparently, it solved the problem about threads getting stucked in ReceiveBuf call, but for some unknown reason, none (not even the ones that was working right) threads get inside the 'if SizeBuf > 0'.
Any help?
//Edit showing more of Thread code::
The Thread.Execute is like this:
procedure MyThread.Execute;
begin
while not(Terminated) do
begin
if SocketConnect then
begin
if ReceiveProtocolVersion then
begin
DoAuthentication;
end;
end;
MySocket.Close;
MySocket.Free;
end;
Terminate;
end;
The SocketConnect function is:
function MyThread.SocketConnect: bool;
begin
Result:= false;
MySocket:= TClientSocket.Create(Nil);
MySocket.Port:= StrToInt(Form1.Edit1.Text);
MySocket.ClientType:= ctBlocking;
MySocket.Host:= Host; //Host is a private variable for thread class
try
MySocket.Active:= true;
if (MySocket.Socket.Connected = true) then
Result:= true;
except
Terminate;
end;
end;
I fix the problem using TWinSocketStream. Something like this:
function MyThread.CheckProtocol: bool;
var
SockStream: TWinSocketStream;
ProtocolVersion: array[0..11] of AnsiChar;
begin
try
SockStream := TWinSocketStream.Create(MySocket.Socket, 3000);
SockStream.Read(ProtocolVersion, SizeOf(ProtocolVersion));
RFBVer:= AnsiString(ProtocolVersion);
....
I read that the correct way to work with blocking-mode sockets is by sending/receiving data over TWinSocketStream in:
DocWiki Embarcadero
Anyway, thank for the guys who tried to help!
So, my goal is start a function in another thread. Also i need access to other vcl components from new thread. Here is my code so far:
procedure TForm1.StartButtonClick(Sender: TObject);
var
thread1: integer;
id1: longword;
begin
thread1 := beginthread(nil,0,Addr(Tform1.fetchingdata),nil,0,id1);
closehandle(thread1);
end;
procedure TForm1.FetchingData;
var
...
begin
Idhttp1.IOHandler := IdSSLIOHandlerSocketOpenSSL1; //<- error
idhttp1.Request.ContentType := 'application/x-www-form-urlencoded';
my program hangs and i get error: Exception EAccessViolation in module my.exe at 00154E53. Access violation at address 00554E53 in module 'my.exe'. Read of address 00000398.
Thanks in advance.
The cause of the AV is that you pass the address of a TForm method to a function that expects a TThreadFunc (see the documentation of System.BeginThread()). Using Addr() like this is a good way to keep the compiler from pointing out your bugs.
What you would need to do instead is to write a wrapper function that has the correct signature, pass the form instance as the parameter, and call the method on the form from that function.
But don't go there, either write your code as a descendant of TThread, or (preferably) use a higher level wrapper like AsyncCalls or the Omni Thread Library. And make sure that you don't access VCL components in the main thread, create and free those that you need in your worker thread.
The VCL (Gui components) is only to be accessed from the main thread. Other threads need the main thread to access the VCL.
You could try the same thing with a regular TThread if you're using Delphi or Lazarus.
type
TSeparateThread = class(TThread)
private
protected
public
constructor Create(IfSuspend: Boolean);
proceedure Execute; override;
// variables to fill go here
// s : String;
// i : Integer;
// etc...
end;
constructor TSeparateThread.Create(IfSuspend: Boolean);
begin
inherited Create(IfSuspend);
end;
procedure TSeparateThread.Execute;
begin
// This is where you will do things with those variables and then pass them back.
YourMainUnitOrForm.PublicVariableOf := s[i];
// passes position 0 of s to PublicVariableOf in your Main Thread
end;
Calling the new Thread is done as follows:
with TSeparateThread.Create(true) do
begin
// This is where you fill those variables passed to the new Thread
s := 'from main program';
i := 0;
// etc...
Resume;
//Will Start the Execution of the New Thread with the variables filled.
end;