For debugging purposes, I am iterating the threads of my own application, and trying to report the thread times (looking for a rogue thread). When I iterate the threads, I get access denied if the threadId = GetCurrentThreadId.
Here's an example of code to demonstrate the problem (delphi):
program Project9;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Windows, System.SysUtils, TlHelp32;
type
TOpenThreadFunc = function(DesiredAccess: DWORD; InheritHandle: BOOL; ThreadID: DWORD): THandle; stdcall;
var
OpenThreadFunc: TOpenThreadFunc;
function OpenThread(id : DWORD) : THandle;
const
THREAD_GET_CONTEXT = $0008;
THREAD_QUERY_INFORMATION = $0040;
var
Kernel32Lib, ThreadHandle: THandle;
begin
Result := 0;
if #OpenThreadFunc = nil then
begin
Kernel32Lib := GetModuleHandle(kernel32);
OpenThreadFunc := GetProcAddress(Kernel32Lib, 'OpenThread');
end;
result := OpenThreadFunc(THREAD_QUERY_INFORMATION, False, id);
end;
procedure dumpThreads;
var
SnapProcHandle: THandle;
NextProc : Boolean;
TThreadEntry : TThreadEntry32;
Proceed : Boolean;
pid, tid : Cardinal;
h : THandle;
begin
pid := GetCurrentProcessId;
tid := GetCurrentThreadId;
SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); //Takes a snapshot of the all threads
Proceed := (SnapProcHandle <> INVALID_HANDLE_VALUE);
if Proceed then
try
TThreadEntry.dwSize := SizeOf(TThreadEntry);
NextProc := Thread32First(SnapProcHandle, TThreadEntry);//get the first Thread
while NextProc do
begin
if TThreadEntry.th32OwnerProcessID = PID then //Check the owner Pid against the PID requested
begin
write('Thread '+inttostr(TThreadEntry.th32ThreadID));
if (tid = TThreadEntry.th32ThreadID) then
write(' (this thread)');
h := OpenThread(TThreadEntry.th32ThreadID);
if h <> 0 then
try
writeln(': open ok');
finally
CloseHandle(h);
end
else
writeln(': '+SysErrorMessage(GetLastError));
end;
NextProc := Thread32Next(SnapProcHandle, TThreadEntry);//get the Next Thread
end;
finally
CloseHandle(SnapProcHandle);//Close the Handle
end;
end;
function DebugCtrlC(dwCtrlType : DWORD) :BOOL;
begin
writeln('ctrl-c');
dumpThreads;
end;
var
s : String;
begin
SetConsoleCtrlHandler(#DebugCtrlC, true);
try
writeln('enter anything to see threads, ''x'' to exit. or press ctrl-c to see threads');
repeat
readln(s);
if s <> '' then
dumpThreads;
until s = 'x';
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
I get access denied for this thread when pressing ctrl-c - why can't the thread get a handle to itself, but it can for all the other threads in the process?
are some kernel object can be opened, based on 2 things:
object security descriptor
caller token (thread token if exist, otherwise process token)
usually thread can open self handle, but can be exceptions, one is - thread created by system, for handle console control signals.
minimum code for reproduce (c++):
HANDLE g_hEvent;
BOOL WINAPI HandlerRoutine(DWORD dwCtrlType)
{
if (CTRL_C_EVENT == dwCtrlType)
{
if (HANDLE hThread = OpenThread(THREAD_QUERY_INFORMATION,
FALSE, GetCurrentThreadId()))
{
CloseHandle(hThread);
}
else GetLastError();
SetEvent(g_hEvent);
}
return TRUE;
}
and from console application call
if (g_hEvent = CreateEvent(0, TRUE, FALSE, 0))
{
if (SetConsoleCtrlHandler(HandlerRoutine, TRUE))
{
// send ctrl+c, for not manually do this
if (GenerateConsoleCtrlEvent (CTRL_C_EVENT, 0))
{
WaitForSingleObject(g_hEvent, INFINITE);
}
SetConsoleCtrlHandler(HandlerRoutine, FALSE);
}
CloseHandle(g_hEvent);
}
can in test view that
OpenThread(THREAD_QUERY_INFORMATION, FALSE, GetCurrentThreadId()) failed with error - ERROR_ACCESS_DENIED
why this happen ? need look for thread security descriptor. the simply code for this can look like:
void DumpObjectSD(HANDLE hObject = GetCurrentThread())
{
ULONG cb = 0, rcb = 0x40;
static volatile UCHAR guz;
PVOID stack = alloca(guz);
PSECURITY_DESCRIPTOR psd = 0;
do
{
if (cb < rcb)
{
cb = RtlPointerToOffset(psd = alloca(rcb - cb), stack);
}
if (GetKernelObjectSecurity(hObject,
OWNER_SECURITY_INFORMATION|DACL_SECURITY_INFORMATION|LABEL_SECURITY_INFORMATION,
psd, cb, &rcb))
{
PWSTR sz;
if (ConvertSecurityDescriptorToStringSecurityDescriptor(psd, SDDL_REVISION_1,
OWNER_SECURITY_INFORMATION|DACL_SECURITY_INFORMATION|LABEL_SECURITY_INFORMATION, &sz, &rcb))
{
DbgPrint("%S\n", sz);
LocalFree(sz);
}
break;
}
} while (GetLastError() == ERROR_INSUFFICIENT_BUFFER);
}
and call this from console handler thread and from usual (first thread) for compare.
the SD of usual process thread can look like:
for not elevated process:
O:S-1-5-21-*
D:(A;;0x1fffff;;;S-1-5-21-*)(A;;0x1fffff;;;SY)(A;;0x121848;;;S-1-5-5-0-LogonSessionId)
S:AI(ML;;NWNR;;;ME)
or for elevated ( running as admin)
O:BA
D:(A;;0x1fffff;;;BA)(A;;0x1fffff;;;SY)(A;;0x121848;;;S-1-5-5-0-LogonSessionId)
S:AI(ML;;NWNR;;;HI)
but when this called from handler thread (auto created by system) - we got another dacl:
for not elevated:
O:BA
D:(A;;0x1fffff;;;S-1-5-21-*)(A;;0x1fffff;;;SY)(A;;0x121848;;;S-1-5-5-0-LogonSessionId)
S:AI(ML;;NWNR;;;SI)
for elevated:
O:BA
D:(A;;0x1fffff;;;BA)(A;;0x1fffff;;;SY)(A;;0x121848;;;S-1-5-5-0-LogonSessionId)
S:AI(ML;;NWNR;;;SI)
different here in SYSTEM_MANDATORY_LABEL
S:AI(ML;;NWNR;;;SI)
the "ML" here is SDDL_MANDATORY_LABEL (SYSTEM_MANDATORY_LABEL_ACE_TYPE)
Mandatory label rights:
"NW" - SDDL_NO_WRITE_UP (SYSTEM_MANDATORY_LABEL_NO_WRITE_UP)
"NR" - SDDL_NO_READ_UP ( SYSTEM_MANDATORY_LABEL_NO_READ_UP )
and point main - label value (sid):
handler thread always have "SI" - SDDL_ML_SYSTEM - System integrity level.
while usual threads have "ME" - SDDL_MLMEDIUM - Medium integrity level or
"HI" - SDDL_ML_HIGH - High integrity level, when run as admin
so - because this thread have higher integrity level ( System ) than usual process integrity level in token ( High integrity level or bellow, if not system process) and with no read and write up rights - we can not open this thread with read or write access, only with execute access.
we can do next test in HandlerRoutine - try open thread with MAXIMUM_ALLOWED and look for granted access with NtQueryObject ( use ObjectBasicInformation )
if (HANDLE hThread = OpenThread(MAXIMUM_ALLOWED, FALSE, GetCurrentThreadId()))
{
OBJECT_BASIC_INFORMATION obi;
if (0 <= ZwQueryObject(hThread, ObjectBasicInformation, &obi, sizeof(obi), 0))
{
DbgPrint("[%08x]\n", obi.GrantedAccess);
}
CloseHandle(hThread);
}
we got here: [00101800] which mean:
SYNCHRONIZE | THREAD_RESUME | THREAD_QUERY_LIMITED_INFORMATION
also we can query ObjectTypeInformation and get GENERIC_MAPPING for thread object.
OBJECT_BASIC_INFORMATION obi;
if (0 <= ZwQueryObject(hThread, ObjectBasicInformation, &obi, sizeof(obi), 0))
{
ULONG rcb, cb = (obi.TypeInfoSize + __alignof(OBJECT_TYPE_INFORMATION) - 1) & ~(__alignof(OBJECT_TYPE_INFORMATION) - 1);
POBJECT_TYPE_INFORMATION poti = (POBJECT_TYPE_INFORMATION)alloca(cb);
if (0 <= ZwQueryObject(hThread, ObjectTypeInformation, poti, cb, &rcb))
{
DbgPrint("a=%08x\nr=%08x\nw=%08x\ne=%08x\n",
poti->GenericMapping.GenericAll,
poti->GenericMapping.GenericRead,
poti->GenericMapping.GenericWrite,
poti->GenericMapping.GenericExecute);
}
}
and got
a=001fffff
r=00020048
w=00020437
e=00121800
so we in general can open this thread with GenericExecute access, except 00020000 (READ_CONTROL) because this access in GenericRead and GenericWrite and policy - no read/write up.
however for almost all api, where handle (thread or generic) required, we can use GetCurrentThread() - pseudo handle for the calling thread. of course this can use only for current thread. so we can call for example
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
GetThreadTimes(GetCurrentThread(), &CreationTime, &ExitTime, &KernelTime, &UserTime);
the CloseHandle(GetCurrentThread()); also valid call - Calling the CloseHandle function with this handle has no effect. (simply nothing will be). and this pseudo handle have GENERIC_ALL granted access.
so your OpenThread routine can check for thread id - if it is equal to GetCurrentThreadId() - simply return GetCurrentThread().
also we can call
DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), &hThread, 0, 0, DUPLICATE_SAME_ACCESS);
this also will be work well for this thread. however usual use GetCurrentThread() is enough
So actually it turns out that there's a very specific set of conditions that means that a console can't get a handle to the thread in the thread itself - and that's when the thread is created in the console host to pass a CTRL+C notification to the console (the test conditions I was testing under)
Related
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
When my main application (Delphi 2009) terminates, I want it to signal my threads (timers, TDataModules with ADO Connections, SMTP etc) to dispose gracefully.
In my main application, I have the following:
try
PostThreadMessage(bpvccMAILER.ThreadID, WM_SYSTEM_CLOSE, self.Handle, 0);
returnMessage := (SysErrorMessage(GetLastError)); //Returns 'The operation completed successfully'
while TRUE do
begin
sleep(1000);
if not (Assigned(bpvccMAILER)) then
begin
bpvccACTIVITY_LOGGER.Write('SHUTDOWN','TBPVCommunicatorGUI.FormClose - All Threads have shut down');
break;
end;
locWaited := locWaited + 10;
end;
except
end;
finally
FreeAndNil(bpvccACTIVITY_LOGGER);
FreeAndNil(bpvccMAILER);
end;
Thread class:
TBPVMailer = class(TThread)
protected
SMTP : TIdSMTP;
interval : Integer;
fMain : Integer;
fMainIsSvc : Boolean;
fTerminated: Boolean;
function SendEmail(AEmail: TEmailObj) : TBPVEmailSendResult;
function doSleep : Boolean;
procedure Write(AStatus, AMessage : String);
procedure FlushQueue();
procedure HandleMessage(var Message : TMessage); message WM_SYSTEM_CLOSE;
public
constructor Create(AServer : String; APort : Integer; AUser, APass : String; AInterval : Integer; StartSuspended : Boolean); overload;
procedure Execute; override;
procedure QueueEmail(AEmail: TEmailObj; EmailType : TBPVEmailType; AssociatedID : String);
destructor Destroy; override;
end;
procedure TBPVMailer.HandleMessage(var Message: TMessage);
var
msg : tagMSG;
begin
PeekMessage(&msg, 0, 0, 0, PM_NOREMOVE);
fMain := Message.WParam;
fMainIsSvc := Message.LParam = 1;
fTerminated := TRUE;
end;
Problem is, Assigned(bpvccMAILER) always returns true even after calling PostThreadMessage. Also, bpvccMAILER.fTerminated is always FALSE, which means the TBPVMailer.HandleMessage is never executed because that is were the value is set to TRUE. What am I doing wrong, it appears that my threads arent receiving the messages?
The obvious explanation is that you don't have a message pump in your thread. You post the message, but the thread does not pump its queue.
The code is needlessly complex though. There seems to be no need for messages at all. Call the Terminate method of the thread and then use its WaitFor method to wait until it stops. Or even simpler, just call Free on the thread.
Your code does contain a number of oddities:
Why do you call PeekMessage? That serves no purpose that I can discern.
Waiting with Sleep should be avoided. You can almost always use dedicated wait functions.
It's odd the you wait until bpvccMAILER is nil, but then use FreeAndNil(bpvccMAILER).
You must only call GetLastError when it is well-defined. Typically that is only when the preceeded API call has failed. And failure is indicated by the value returned by the API call.
The Sleep loop in the main thread is not OK since it blocks processing messages.
Just call the PostThreadMessage and return, without any Sleep loop afterwards.
If you need to wait until bpvccMAILER finishes, add code that on completion send a PostMessage to your main thread. So, the main thread will handle this message and will be aware that the auxiliary thread has finished. It may not be easy to change your application this way straight from the start, but little by little you will be designing applications in such a way that always does correct thread handling.
Besides that, if you use PostThreadMessage, then your Thread.Execute loop must have MsgWaitForMultipleObjects.
Here is an example on how the Thread.Execute loop have to be:
<skipped>
repeat
<skipped>
R := MsgWaitForMultipleObjects(EventCount, EventArray, False, INFINITE, QS_ALLINPUT);
<skipped>
if R = WAIT_OBJECT_0 + EventCount then
begin
while PeekMessage(M, 0, 0, 0, PM_REMOVE) do
begin
if M.Message = WM_QUIT then
Break;
TranslateMessage(M);
DispatchMessage(M);
end;
if M.Message = WM_QUIT then
Break;
end;
<skipped>
until Terminated;
<skipped>
If your application will eventually need to exit while the tread is running (assume your thread object is in T variable), do the following:
T.Terminate;
SetEvent([one of the event of the EventArray]); // we should call it AFTER terminate for the Terminated property would already be True when the tread exits from MsgWaitForMultipleObjects
T.WaitFor;
T.Free; // "Free" calls "WaitFor" anyway, but Remy Lebeau suggests to explicitly call "WaitFor" before "Free".
T := nil;
I am using a thread to access a pop3 account and retrieve messages. It works fine, but it locks up my application until it is complete. Cant move the window, shut down, click buttons, nothing.
It runs fine and allows me to access the main application up until the spot i commented out (or after the IdPOP31.Connect();)
//Getting the number of the messages that server has
then it locks up
procedure TPopThread.Pop;
var
vName, vEmail, vServerIn, vServerOut, vUserId, vPassword: String;
vPop3Port, vSMTPPort, vSSL: String; vHTML: TStringList;
MsgCount : Integer;
i,j : Integer;
FMailMessage : TIdMessage;
begin
with frmMain do
begin
RzMemo1.Lines.Clear;
vHTML:= TStringList.Create;
GetAccount(lbxMain.SelectedItem,vName, vEmail, vServerIn, vServerOut, vUserId, vPassword,
vPop3Port, vSMTPPort, vSSL, vHTML);
IdPOP31.Host := vServerIn;
IdPOP31.Username := vUserId;
IdPOP31.Password := vPassword;
IdPOP31.Port := StrToInt(vPop3Port);
try
Prepare(IdPOP31);
IdPOP31.Connect();
// {
// //Getting the number of the messages that server has.
// MsgCount := IdPOP31.CheckMessages;
// for i:= 0 to Pred(MsgCount) do
// begin
// try
// FMailMessage := TIdMessage.Create(nil);
// IdPOP31.Retrieve(i,FMailMessage);
// RzMemo1.Lines.Add('=================================================');
// RzMemo1.Lines.Add(FMailMessage.From.Address);
// RzMemo1.Lines.Add(FMailMessage.Recipients.EMailAddresses);
// RzMemo1.Lines.Add(FMailMessage.Subject);
// RzMemo1.Lines.Add(FMailMessage.Sender.Address);
// RzMemo1.Lines.Add(FMailMessage.Body.Text);
//
// for J := 0 to Pred( FMailMessage.MessageParts.Count ) do
// begin
// // if the part is an attachment
// if ( FMailMessage.MessageParts.Items[ J ] is TIdAttachment) then
// begin
// RzMemo1.Lines.Add('Attachment: ' + TIdAttachment(FMailMessage.MessageParts.Items[J]).Filename);
// end;
// end;
// RzMemo1.Lines.Add('=================================================');
// finally
// FMailMessage.Free;
// end;
// RzMemo1.Clear;
// end;
// }
finally
IdPOP31.Disconnect;
vHTML.Free;
end;
end;
end;
It actually did this before I added the thread, so it has something to do with that portion that is commented out and not the thread
What did i do wrong or didn't do?
here is my Execute
procedure TPopThread.Execute;
begin
try
Synchronize(Pop);
except
on Ex: Exception do
fExceptionMessage := Ex.Message;
end;
end;
here is how i call it
PopThread := TPopThread.Create(lbxMain.SelectedItem, frmMain.DonePopping);
You are locking up the application yourself, because you're synchronizing the call to the pop method.
Synchronize causes the call specified by AMethod to be executed using the main thread, thereby avoiding multithread conflicts.
The current thread is passed in the AThread parameter.
If you are unsure whether a method call is thread-safe, call it from within the Synchronize method to ensure it executes in the main thread.
Execution of the current thread is suspended while the method executes in the main thread.
So, for practical purposes, you're like you have no extra thread, since all your code is executed in the main thread.
An example of when you would want to use Synchronize is when you want to interact with a VCL component
On the other hand, because you're directly accessing a number of visual controls from your method, and the VCL is not thread safe, you have to execute your method in the main thread.
The best you can do is to make your thread independent from the VCL by not accessing any VCL component from the thread, but rather collecting all the input and output values in memory and setting/reading it from the main thread before the thread starts and after the thread finishes.
Or, if for any reason you don't want to do that, you can dissect your method to separate the parts that need access to the VCL and synchronize only that parts, for example:
type
TPopThread = class
private
FMailMessage : TIdMessage; //now the message belongs to the class itself
...
public
//all the values are passed via constructor or the thread is
//created in suspended state, configured and then started
property Host: string read FHost write FHost;
property UserName: string read FUserName write FUserName;
property Password: string read ...;
property Port: Integer read ...;
end;
procedure TPopThread.CopyMailToGUI;
var
J: Integer;
begin
frmMain.RzMemo1.Lines.Add('=================================================');
frmMain.RzMemo1.Lines.Add(FMailMessage.From.Address);
frmMain.RzMemo1.Lines.Add(FMailMessage.Recipients.EMailAddresses);
frmMain.RzMemo1.Lines.Add(FMailMessage.Subject);
frmMain.RzMemo1.Lines.Add(FMailMessage.Sender.Address);
frmMain.RzMemo1.Lines.Add(FMailMessage.Body.Text);
for J := 0 to Pred( FMailMessage.MessageParts.Count ) do
begin
// if the part is an attachment
if ( FMailMessage.MessageParts.Items[ J ] is TIdAttachment) then
begin
frmMain.RzMemo1.Lines.Add('Attachment: ' + TIdAttachment(FMailMessage.MessageParts.Items[J]).Filename);
end;
end;
frmMain.RzMemo1.Lines.Add('=================================================');
end;
procedure TPopThread.Pop;
var
MsgCount : Integer;
i,j : Integer;
Pop: TIdPOP3;
begin
Pop := TIdPOP3.Create(nil);
try
Pop.Host := FHost;
Pop.Username := FUserName;
Pop.Password := FPassword;
Pop.Port := FPort;
Prepare(Pop);
Pop.Connect();
//Getting the number of the messages that server has.
MsgCount := Pop.CheckMessages;
for I := 0 to Pred(MsgCount) do
begin
try
FMailMessage := TIdMessage.Create(nil);
try
IdPOP31.Retrieve(i,FMailMessage);
Synchronize(CopyMailToGUI);
finally
FMailMessage.Free;
end;
end;
finally
Pop.Free;
end;
end;
procedure TPopThread.Execute;
begin
//no need of a try/except, if an exception occurs, it
//is stored in the FatalException property
Pop;
end;
Now, your thread will ask the main thread to copy just the processed message to the VCL. During that copy your thread will block and your application will not respond to messages because the main thread is busy, but that will be for very shorts intervals, so even if it is not the ideal case, I think it will work for what you want.
You put all your logic inside a Synchronize call. Synchronize runs its function in the main VCL thread, so you've essentially nullified any benefits you might have gained from using a separate thread in the first place.
Remove the call to Synchronize so that Pop runs in the thread you created for it.
If you still need some operations to execute in the main thread, then put them in subroutines so that you can run only them in Synchronize. The parts I see in that code are the places where you add lines to a memo control.
After reading this very interesting topic on stackoverflow --> How to wait for COM port receive event before sending more data in a loop
I've ran into many problems and i've tried many solutions ... nothing work well unfortunately !
Many serial port libraries are event-driven and i'm having a hard time understanding them.
I've tried with Asyncpro, Synaser and TComport.
Is it possible to have a function like this:
SerialSendandReply(tx string here,timeout) return rx string and if timeout send a error string
Response from the device are withing milliseconds a blocking way to do it would be better?
Like this:
Dosomething here
showmessage(SerialSendandReply('test',100 )); //100 ms timeout
dosomething else
With this code
TForm1 = class(TForm)
...
private
IOEvent : THandle; // used for IO events
IORx : string;
Comport : TapdComport;
...
procedure TForm1.ComportTriggerAvail(CP: TObject; Count: Word);
var i : integer;
begin
for i:=1 to Count do
IORx:=IORx+Comport.GetChar;
SetEvent(IOEvent);
end;
function TForm1.SerialSAWR(tx : string; TimeOut : integer) : boolean;
begin
Result := False;
try
IORx := ''; // your global var
ResetEvent(IOEvent);
Comport.PutString(tx);
Result := WaitForSingleObject(IOEvent, TimeOut) = WAIT_OBJECT_0;
except
on E : Exception do
// dosomething with exception
end;
end;
// constructor part
IOEvent := CreateEvent(nil, True, False, nil);
// destructor part
if IOEvent <> 0 then
CloseHandle(IOEvent);
Then i've tried to call this function :
if SerialSAWR('test'; 5000) then showmessage(IORx);
Sending is working great but doesn't return anything in the string.
Any advices?
Thank you very much!
Regards,
Laurent
I use TComPort and have created the following routine to do what you ask. TComPort monitors received characters in its monitoring thread and my routine waits for characters without calling Application.ProcessMessages. It may not be the most elegant code but it works fine.
function TArtTComPort.SerialPort_AwaitChars(AMinLength: integer;
ATerminator: char; AQtyAfterTerm: integer; ARaise: boolean): string;
var
fDueBy : TDateTime;
function IsEndOfReplyOrTimeout( var AStr : string ) : boolean;
var
I : integer;
begin
Result := False;
If ATerminator <> #0 then
begin
I := Length( AStr ) - AQtyAfterTerm;
If I > 0 then
Result := AStr[I] = ATerminator;
end;
If not Result then
Result := Length(AStr) >= AMinLength;
// Un-comment this next line to disable the timeout.
//Exit;
If not Result then
begin
Result := Now > fDueBy;
If Result then
If ARaise then
raise EArtTComPort.Create( 'Serial port reply timeout' )
else
AStr := '';
end;
end;
var
Events : TComEvents;
iCount : integer;
S : string;
begin
Assert( AMinLength > 0, 'Invalid minimum length' );
If not FComPort.Connected then
begin
Result := '';
Exit;
end;
fDueBy := Now + (FTimeoutMS * TDMSec );
Result := '';
Repeat
// Setup events to wait for:
Events := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak,
evCTS, evDSR, evError, evRLSD, evRx80Full];
// Wait until at least one event happens.
FComPort.WaitForEvent(
Events,
FStopEvent.Handle,
FTimeOutMS);
If Events = [] then // timeout
begin
If ARaise then
raise EArtTComPort.Create( 'Serial port reply timeout' )
end
else
begin
If evRxChar in Events then
begin
iCount := FComport.InputCount;
FComPort.ReadStr( S, iCount );
Result := Result + S;
end;
end;
until IsEndOfReplyOrTimeout( Result );
end;
I switched for nrComm Lib (v9.31)... very simple of use and well supported.
The only drawback is that isn't free and open source ... but it's worth it !
It's also thread-safe which is good too :).
Thank you very much everyone for the replies!
You are trying to do async I/O from the main thread. This will never play well with the GUI.
Doing complex async I/O is better suited in a separate thread. I have a blocking serial communication package (I think Synaser also has a blocking mode) and a function like this:
function TransmitReceive(const msg: AnsiString; var reply: AnsiString;
timeOut: Integer): Boolean;
Put the complex code logic inside a thread.execute and trig the start of the logic with an event signal.
Communicate results etc to the main thread through PostMessage calls for example.
I am working on kind of a download manager that's Multithreaded.
Each Thread has it's own ID/Handles/URL/etc.
I would to implement something like Pause/Resume/Cancel a download.
I have the ThreadHandles stored in a listview so I could Suspend/Resume/Terminate the download Threads. I haven't tried Suspend/Resume yet because I am currently working on cancel a download. The only problem is if I suspend a thread, the FileHandles/DLHandles get not closed.
Since the handles are stacked in the thread. Is there a possibility to get the pointer that I passed for CreateThread?
How I create Threads
type
PTR_Download = ^TTDownload;
TTDownload = record
URL: string;
ThreadHandle : Longword;
// .....
end;
function DownloadFile ( p : pointer ) : Integer; stdcall; // The Thread
var
_infos: TTDownload;
begin
CopyMemory(#_infos, p, SizeOf(_infos));
DownloadFile (_infos.URL); // just example
// .... and so on
// .... Handles get created here FileHandle/InternetOpenHandle/etc..
end;
function StartNewDownload (Link : String)
var
DL : PTR_Download;
ThreadID : DWORD;
begin
DL := PTR_Download(LocalAlloc(LPTR, SizeOf(TTDownload)));
DL^.URL := Link;
DL.ThreadHandle := CreateThread(nil, 0, #DownloadFile, DL, 0, ThreadID);
end;
function AnotherFunction (dummy : String) : Bool;
begin
GetParameterPointerOfThreadHandle (AnyHandleHere) // Something like that?!
end;
I basically need just something that closes the open handles from the terminated threads.
Any Ideas?