using Delphi XE2 and TJvHidDevice class from Jedi library, I managed to successfully communicate with a USB device (pic32mx7 board, with my code running on it). The usual way of "send request, wait for single response" works.
The problem is with a command that results in a larger number of consecutive responses. If those responses are sent by the device as fast as possible - or even if I add a small delay between them like 5ms - I lose packets (reports? frames?). The OnDeviceData event simply doesn't seem to fire for all of them. If I add larger delays in the device's code, the problem goes away.
I used USBPcap program to capture USB data and dump it to a file which, once I open it in WireShark, contains all of the data sent by the device (I send 255 packets as a test, with all zeroes and one "1" shifting its place by 1 position in every packet). So, I think both the device and Windows are doing their job.
To make sure my Delphi code is not faulty, I tried the Jedi example project "DevReader" (here is the main.pas code) which dumps data on screen and it is missing packets as well.
I feel like there should be more information on the net about Jedi's USB classes but I am having trouble finding it.
I may be able to avoid this problem by aggregating/condensing the device's responses, but would still like to know what's going on.
Edit:
Tried from a console app: packets were not lost anymore.
Modified the Jedi demo app to only count received packets and update a counter label on screen (no forced window repaint) - no lost packets.
Added sleep(1) in the OnData event - no lost packets.
Added sleep(2) in the OnData event - losing packets again.
This looks like the Jedi thread that reads data must not be delayed by any processing - shouldn't there be some buffering of data going on (by Windows?) that would allow for this type of processing delays? Judging by the packet loss "pattern" it seems as if there is buffering, but it is insufficient because I can receive e.g. 30 packets then lose 5 then receive another 20 etc.
I will modify my code to copy the data and exit the OnData event as quickly as possible so that the thread has minimum "downtime" and I will report the outcome.
Since the cause of the problem appears to be related to the amount of time the USB reading thread is blocked by Synchronise, i.e. the data processing carried out by the main thread, I made changes in the thread code, (TJvHidDeviceReadThread class, JvHidControllerClass.pas unit). Any code that used this unit and the classes contained should still work without any modifications, nothing public was changed.
New behavior: every time the data is read, it is placed in a thread safe list. Instead of Synchronise it now uses Queue, but only if it is not queued already. The Queued method reads from the thread safe list until it is empty. It fires an event (same event as in the old code) for each buffered report in the list. Once the list is empty, the "Queued" flag is reset and the next read will cause Queuing again.
In the tests so far I did not encounter lost packets.
The thread class was extended:
TJvHidDeviceReadThread = class(TJvCustomThread)
private
FErr: DWORD;
// start of additions
ReceivedReports : TThreadList;
Queued: boolean;
procedure PushReceivedReport(const bytes: array of byte; const NumBytesRead: cardinal);
function PopReceivedReport(var ReportID: byte; var ReportBytes: TBytes): boolean;
procedure FlushBuffer;
// end of additions
procedure DoData;
procedure DoDataError;
constructor CtlCreate(const Dev: TJvHidDevice);
protected
procedure Execute; override;
public
Device: TJvHidDevice;
NumBytesRead: Cardinal;
Report: array of Byte;
constructor Create(CreateSuspended: Boolean);
//added destructor:
destructor Destroy; override;
end;
In the implementation section, the following was modified:
constructor TJvHidDeviceReadThread.CtlCreate(const Dev: TJvHidDevice);
begin
inherited Create(False);
// start of changes
ReceivedReports := TThreadList.Create;
// end of changes
Device := Dev;
NumBytesRead := 0;
SetLength(Report, Dev.Caps.InputReportByteLength);
end;
procedure TJvHidDeviceReadThread.Execute;
...
...
...
//replaced: Synchronize(DoData); with:
PushReceivedReport (Report, NumBytesRead);
...
And the following was added:
type
TReport = class
ID: byte;
Bytes: TBytes;
end;
destructor TJvHidDeviceReadThread.Destroy;
var
l: TList;
begin
RemoveQueuedEvents (self);
try
l := ReceivedReports.LockList;
while l.Count>0 do
begin
TReport(l[0]).Free;
l.Delete(0);
end;
finally
ReceivedReports.UnlockList;
FreeAndNil (ReceivedReports);
end;
inherited;
end;
procedure TJvHidDeviceReadThread.FlushBuffer;
var
ReportID: byte;
ReportBytes: TBytes;
begin
while PopReceivedReport (ReportID, ReportBytes) do
Device.OnData(Device, ReportID, ReportBytes, length(ReportBytes));
end;
function TJvHidDeviceReadThread.PopReceivedReport(var ReportID: byte; var ReportBytes: TBytes): boolean;
var
l: TList;
rep: TReport;
begin
l := ReceivedReports.LockList;
rep := nil;
try
result := l.Count>0;
if result
then
begin
rep := l[0];
l.Delete(0);
end
else Queued := false;
finally
ReceivedReports.UnlockList;
end;
if result then
begin
ReportID := rep.ID;
SetLength(ReportBytes, length(rep.Bytes));
System.move (rep.Bytes[0], ReportBytes[0], length(rep.Bytes));
rep.Free;
end;
end;
procedure TJvHidDeviceReadThread.PushReceivedReport(const bytes: array of byte; const NumBytesRead: cardinal);
var
rep: TReport;
begin
rep := TReport.Create;
setlength (rep.Bytes, NumBytesRead-1);
rep.ID := Bytes[0];
System.move (Bytes[1], rep.Bytes[0], NumBytesRead-1);
// explicitely lock the list just to provide a locking mechanism for the Queue flag as well
ReceivedReports.LockList;
try
if not Queued then
begin
Queued := true;
Queue (FlushBuffer);
end;
ReceivedReports.Add(rep);
finally
ReceivedReports.UnlockList;
end;
end;
Related
There's something I don't understand about waitable timers. I searched online and read specs on MSDN plus whatever I could find on stackoverflow (such as link) but my timers fire almost immediately after the PC is suspended.
To focus on the problem I wrote a small test app using XE5 (64-bit) in Windows 7 and tried to duplicate the project found here: http://www.codeproject.com/Articles/49798/Wake-the-PC-from-standby-or-hibernation
I thought the problem was the way I derive time but I can't seem to find the problem.
The test app looks like this (very simple):
I declare the thread type as follows
type
TWakeupThread = class(TThread)
private
FTime: LARGE_INTEGER;
protected
procedure Execute; override;
public
constructor Create(Time: LARGE_INTEGER);
end;
...
constructor TWakeupThread.Create(Time: LARGE_INTEGER);
begin
inherited Create(False);
FreeOnTerminate:=True;
FTime:=Time;
end;
procedure TWakeupThread.Execute;
var
hTimer: THandle;
begin
// Create a waitable timer.
hTimer:=CreateWaitableTimer(nil, True, 'WakeupThread');
if (hTimer <> 0) then
begin
//CancelWaitableTimer(hTimer);
if (SetWaitableTimer(hTimer, FTime.QuadPart, 0, nil, nil, True)) then
begin
WaitForSingleObject(hTimer, INFINITE);
end;
CloseHandle(hTimer);
end;
end;
Now when the "Set timer" button is clicked I calculate file time this way and create the thread.
procedure TForm1.btnSetTimerClick(Sender: TObject);
var
iUTCTime : LARGE_INTEGER;
SysTime : _SystemTime;
FTime : _FileTime;
hHandle : THandle;
dt : TDateTime;
begin
ReplaceDate(dt,uiDate.DateTime);
ReplaceTime(dt,uiTime.DateTime);
DateTimeToSystemTime(dt, SysTime);
SystemTimeToFileTime(SysTime, FTime);
LocalFileTimeToFileTime(FTime, FTime);
iUTCTime.LowPart := FTime.dwLowDateTime;
iUTCTime.HighPart := FTime.dwHighDateTime;
TWakeupThread.Create(iUTCTime);
end;
This does not work. The timer seems to fire less then 2 minutes after the system enters suspend mode regardless of the amount of time selected. Any pointers as to what I am doing wrong would be appreciated.
EDIT
Found this interesting command line tool that let's us inspect the waitable timers. From command you can "see" the state of your waitable timers by typing:
powercfg -waketimers
I can use this to confirm that my timers are being set properly. I can also use this to confirm that my timers are still running when the PCs prematurely wake-up.
Using the same tool you can get a list of devices that are able to wake from hibernation (mouse, keyboard, network in my case):
powercfg -devicequery wake_armed
On all systems tested, the command "powercfg -lastwake" returns the following which I do not know how to decipher:
Wake History Count - 1
Wake History [0]
Wake Source Count - 0
I enabled both sleep and hibernate in Windows and both will wake up after a few seconds. There's no keyboard / mouse activity and we don't have devices sending WOL (wake-on-lan) requests to these PCs.
I'm wondering if there's something special I need to do when calling SetSuspendState; here's my code:
function SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent: Boolean): Boolean;
//Hibernate = False : system suspends
//Hibernate = True : system hibernates
begin
if not Assigned(_SetSuspendState) then
#_SetSuspendState := LinkAPI('POWRPROF.dll', 'SetSuspendState');
if Assigned(_SetSuspendState) then
Result := _SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent)
else
Result := False;
end;
function LinkAPI(const module, functionname: string): Pointer;
var
hLib: HMODULE;
begin
hLib := GetModuleHandle(PChar(module));
if hLib =0 then
hLib := LoadLibrary(PChar(module));
if hLib <> 0 then
Result := getProcAddress(hLib, PChar(functionname))
else
Result := nil;
end;
procedure TForm1.btnSuspendClick(Sender: TObject);
begin
SetSuspendState(True, False, False);
end;
The problem was not related to delphi or the code in any way. The problem was created by a Windows 7 feature that enables more than magic packets when WOL is enabled. Forcing Windows to only listen for magic packets solved the problem.
MS Link: http://support.microsoft.com/kb/941145
Thank you to everyone who tried to help and especially to David Heffernan who alluded to the possibility that something else was waking up the PC.
I am working on DataSnap project in Delphi XE2 using TCP/IP protocol that needs to pass a stream of binary data to the server as a method parameter. The problem I am running into is that there seems to be a size limit of about 32 KB on the stream contents. Beyond this limit the stream received at the server is empty. If I pass additional method parameters they arrive intact so it seems to be an issue at the parameter level.
Here is how the DataSnap service class is declared:
TDataSnapTestClient = class(TDSAdminClient)
private
FSendDataCommand: TDBXCommand;
public
constructor Create(ADBXConnection: TDBXConnection); overload;
constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
destructor Destroy; override;
procedure SendData(Data: TStream);
end;
The approach I am using should work, at least according to the article by Jim Tierney. That said, there apparently have been changes since Delphi 2009 that have broken Jim Tierney's sample code.
DataSnap Server Method Stream Parameters
Any ideas on how to resolve this issue would be greatly appreciated.
DataSnap transfers the data in 32k chunks. The receiving end has no way of knowing how many bytes will be received until after all chunks have been reassembled. Once all the data has been received, DataSnap doesn't set the size of the TStream that received the data, so you can't use it until you move it to another stream that knows how many bytes are in the stream.
I know that pulling 32k+ from a DataSnap server is not the same as pushing 32k+ to a DataSnap server, but this may work for you as well. Try running the TStream through this code after the DataSnap server finishes receiving the data:
procedure CopyStreamToMemoryStream(const ASource: TStream; var ADest: TMemoryStream; const Rewind: Boolean = True);
const
LBufSize = $F000;
var
LBuffer: PByte;
LReadCount: Integer;
begin
GetMem(LBuffer, LBufSize);
ADest.Clear;
try
repeat
LReadCount := ASource.Read(LBuffer^, LBufSize);
if LReadCount > 0 then
ADest.WriteBuffer(LBuffer^, LReadCount);
until LReadCount < LBufSize;
finally
FreeMem(LBuffer, LBufSize);
end;
if Rewind then
ADest.Seek(0, TSeekOrigin.soBeginning);
end;
I can't remember where I found this code (years ago), so I can't give credit where credit is due, but it has been working for me reliably for years now.
I got thinking about it and it occurred to me that transferring the data to another memory stream just wastes memory, especially if the file is very large. All we need to do is count the bytes and set the stream size, right?!
procedure FixStream(const AStream: TStream);
const
LBufSize = $F000;
var
LBuffer: PByte;
LReadCount, StreamSize: Integer;
begin
GetMem(LBuffer, LBufSize);
try
StreamSize := 0;
repeat
LReadCount := AStream.Read(LBuffer^, LBufSize);
Inc(StreamSize, LReadCount);
until LReadCount < LBufSize;
AStream.Size := StreamSize;
finally
FreeMem(LBuffer, LBufSize);
end;
end;
Do you want to give that a try? I'm not able to test the code right now or I would...
After reading the articles "Simmering Unicode, bring DPL to a boil" and "Simmering Unicode, bring DPL to a boil (Part 2)" of "The Oracle at Delphi" (Allen Bauer), Oracle is all I understand :)
The article mentions Delphi Parallel Library (DPL), lock free data structures, mutual exclusion locks and condition variables (this Wikipedia article forwards to 'Monitor (synchronization)', and then introduces the new TMonitor record type for thread synchronization and describes some of its methods.
Are there introduction articles with examples which show when and how this Delphi record type can be used? There is some documentation online.
What is the main difference between TCriticalSection and TMonitor?
What can I do with the Pulse and PulseAllmethods?
Does it have a counterpart for example in C# or the Java language?
Is there any code in the RTL or the VCL which uses this type (so it could serve as an example)?
Update: the article Why Has the Size of TObject Doubled In Delphi 2009? explains that every object in Delphi now can be locked using a TMonitor record, at the price of four extra bytes per instance.
It looks like TMonitor is implemented similar to Intrinsic Locks in the Java language:
Every object has an intrinsic lock
associated with it. By convention, a
thread that needs exclusive and
consistent access to an object's
fields has to acquire the object's
intrinsic lock before accessing them,
and then release the intrinsic lock
when it's done with them.
Wait, Pulse and PulseAll in Delphi seem to be counterparts of wait(), notify() and notifyAll() in the Java programming language. Correct me if I am wrong :)
Update 2: Example code for a Producer/Consumer application using TMonitor.Wait and TMonitor.PulseAll, based on an article about guarded methods in the Java(tm) tutorials (comments are welcome):
This kind of application shares data
between two threads: the producer,
that creates the data, and the
consumer, that does something with it.
The two threads communicate using a
shared object. Coordination is
essential: the consumer thread must
not attempt to retrieve the data
before the producer thread has
delivered it, and the producer thread
must not attempt to deliver new data
if the consumer hasn't retrieved the
old data.
In this example, the data is a series of text messages, which are shared through an object of type Drop:
program TMonitorTest;
// based on example code at http://download.oracle.com/javase/tutorial/essential/concurrency/guardmeth.html
{$APPTYPE CONSOLE}
uses
SysUtils, Classes;
type
Drop = class(TObject)
private
// Message sent from producer to consumer.
Msg: string;
// True if consumer should wait for producer to send message, false
// if producer should wait for consumer to retrieve message.
Empty: Boolean;
public
constructor Create;
function Take: string;
procedure Put(AMessage: string);
end;
Producer = class(TThread)
private
FDrop: Drop;
public
constructor Create(ADrop: Drop);
procedure Execute; override;
end;
Consumer = class(TThread)
private
FDrop: Drop;
public
constructor Create(ADrop: Drop);
procedure Execute; override;
end;
{ Drop }
constructor Drop.Create;
begin
Empty := True;
end;
function Drop.Take: string;
begin
TMonitor.Enter(Self);
try
// Wait until message is available.
while Empty do
begin
TMonitor.Wait(Self, INFINITE);
end;
// Toggle status.
Empty := True;
// Notify producer that status has changed.
TMonitor.PulseAll(Self);
Result := Msg;
finally
TMonitor.Exit(Self);
end;
end;
procedure Drop.Put(AMessage: string);
begin
TMonitor.Enter(Self);
try
// Wait until message has been retrieved.
while not Empty do
begin
TMonitor.Wait(Self, INFINITE);
end;
// Toggle status.
Empty := False;
// Store message.
Msg := AMessage;
// Notify consumer that status has changed.
TMonitor.PulseAll(Self);
finally
TMonitor.Exit(Self);
end;
end;
{ Producer }
constructor Producer.Create(ADrop: Drop);
begin
FDrop := ADrop;
inherited Create(False);
end;
procedure Producer.Execute;
var
Msgs: array of string;
I: Integer;
begin
SetLength(Msgs, 4);
Msgs[0] := 'Mares eat oats';
Msgs[1] := 'Does eat oats';
Msgs[2] := 'Little lambs eat ivy';
Msgs[3] := 'A kid will eat ivy too';
for I := 0 to Length(Msgs) - 1 do
begin
FDrop.Put(Msgs[I]);
Sleep(Random(5000));
end;
FDrop.Put('DONE');
end;
{ Consumer }
constructor Consumer.Create(ADrop: Drop);
begin
FDrop := ADrop;
inherited Create(False);
end;
procedure Consumer.Execute;
var
Msg: string;
begin
repeat
Msg := FDrop.Take;
WriteLn('Received: ' + Msg);
Sleep(Random(5000));
until Msg = 'DONE';
end;
var
ADrop: Drop;
begin
Randomize;
ADrop := Drop.Create;
Producer.Create(ADrop);
Consumer.Create(ADrop);
ReadLn;
end.
Now this works as expected, however there is a detail which I could improve: instead of locking the whole Drop instance with TMonitor.Enter(Self);, I could choose a fine-grained locking approach, with a (private) "FLock" field, using it only in the Put and Take methods by TMonitor.Enter(FLock);.
If I compare the code with the Java version, I also notice that there is no InterruptedException in Delphi which can be used to cancel a call of Sleep.
Update 3: in May 2011, a blog entry about the OmniThreadLibrary presented a possible bug in the TMonitor implementation. It seems to be related to an entry in Quality Central. The comments mention a patch has been provided by a Delphi user, but it is not visible.
Update 4: A blog post in 2013 showed that while TMonitor is 'fair', its performance is worse than that of a critical section.
TMonitor combines the notion of a critical section (or a simple mutex) along with a condition variable. You can read about what a "monitor" is here:
http://en.wikipedia.org/wiki/Monitor_%28synchronization%29
Any place you would use a critical section, you can use a monitor. Instead of declaring a TCriticalSection, you can simple create a TObject instance and then use that:
TMonitor.Enter(FLock);
try
// protected code
finally
TMonitor.Exit(FLock);
end;
Where FLock is any object instance. Normally, I just create a TObject:
FLock := TObject.Create;
I am having a problem sometimes with a deadlock when destroying some threads. I've tried to debug the problem but the deadlock never seems to exist when debugging in the IDE, perhaps because of the low speed of the events in the IDE.
The problem:
The main thread creates several threads when the application starts. The threads are always alive and synchronizing with the main thread. No problems at all. The threads are destroyed when the application ends (mainform.onclose) like this:
thread1.terminate;
thread1.waitfor;
thread1.free;
and so on.
But sometimes one of the threads (which logs some string to a memo, using synchronize) will lock the whole application when closing. I suspect that the thread is synchronizing when I call waitform and the harmaggeddon happens, but that's is just a guess because the deadlock never happens when debugging (or I've never been able to reproduce it anyway). Any advice?
Logging messages is just one of those areas where Synchronize() doesn't make any sense at all. You should instead create a log target object, which has a string list, protected by a critical section, and add your log messages to it. Have the main VCL thread remove the log messages from that list, and show them in the log window. This has several advantages:
You don't need to call Synchronize(), which is just a bad idea. Nice side effect is that your kind of shutdown problems disappear.
Worker threads can continue with their work without blocking on the main thread event handling, or on other threads trying to log a message.
Performance increases, as multiple messages can be added to the log window in one go. If you use BeginUpdate() and EndUpdate() this will speed things up.
There are no disadvantages that I can see - the order of log messages is preserved as well.
Edit:
I will add some more information and a bit of code to play with, in order to illustrate that there are much better ways to do what you need to do.
Calling Synchronize() from a different thread than the main application thread in a VCL program will cause the calling thread to block, the passed code to be executed in the context of the VCL thread, and then the calling thread will be unblocked and continue to run. That may have been a good idea in the times of single processor machines, on which only one thread can run at a time anyway, but with multiple processors or cores it's a giant waste and should be avoided at all costs. If you have 8 worker threads on an 8 core machine, having them call Synchronize() will probably limit the throughput to a fraction of what's possible.
Actually, calling Synchronize() was never a good idea, as it can lead to deadlocks. One more convincing reason to not use it, ever.
Using PostMessage() to send the log messages will take care of the deadlock issue, but it has its own problems:
Each log string will cause a message to be posted and processed, causing much overhead. There is no way to handle several log messages in one go.
Windows messages can only carry machine-word sized data in parameters. Sending strings is therefore impossible. Sending strings after a typecast to PChar is unsafe, as the string may have been freed by the time the message is processed. Allocating memory in the worker thread and freeing that memory in the VCL thread after the message has been processed is a way out. A way that adds even more overhead.
The message queues in Windows have a finite size. Posting too many messages can lead to the queue to become full and messages being dropped. That's not a good thing, and together with the previous point it leads to memory leaks.
All messages in the queue will be processed before any timer or paint messages will be generated. A steady stream of many posted messages can therefore cause the program to become unresponsive.
A data structure that collects log messages could look like this:
type
TLogTarget = class(TObject)
private
fCritSect: TCriticalSection;
fMsgs: TStrings;
public
constructor Create;
destructor Destroy; override;
procedure GetLoggedMsgs(AMsgs: TStrings);
procedure LogMessage(const AMsg: string);
end;
constructor TLogTarget.Create;
begin
inherited;
fCritSect := TCriticalSection.Create;
fMsgs := TStringList.Create;
end;
destructor TLogTarget.Destroy;
begin
fMsgs.Free;
fCritSect.Free;
inherited;
end;
procedure TLogTarget.GetLoggedMsgs(AMsgs: TStrings);
begin
if AMsgs <> nil then begin
fCritSect.Enter;
try
AMsgs.Assign(fMsgs);
fMsgs.Clear;
finally
fCritSect.Leave;
end;
end;
end;
procedure TLogTarget.LogMessage(const AMsg: string);
begin
fCritSect.Enter;
try
fMsgs.Add(AMsg);
finally
fCritSect.Leave;
end;
end;
Many threads can call LogMessage() concurrently, entering the critical section will serialize access to the list, and after adding their message the threads can continue with their work.
That leaves the question how the VCL thread knows when to call GetLoggedMsgs() to remove the messages from the object and add them to the window. A poor man's version would be to have a timer and poll. A better way would be to call PostMessage() when a log message is added:
procedure TLogTarget.LogMessage(const AMsg: string);
begin
fCritSect.Enter;
try
fMsgs.Add(AMsg);
PostMessage(fNotificationHandle, WM_USER, 0, 0);
finally
fCritSect.Leave;
end;
end;
This still has the problem with too many posted messages. A message needs only be posted when the previous one has been processed:
procedure TLogTarget.LogMessage(const AMsg: string);
begin
fCritSect.Enter;
try
fMsgs.Add(AMsg);
if InterlockedExchange(fMessagePosted, 1) = 0 then
PostMessage(fNotificationHandle, WM_USER, 0, 0);
finally
fCritSect.Leave;
end;
end;
That still can be improved, though. Using a timer solves the problem of the posted messages filling up the queue. The following is a small class that implements this:
type
TMainThreadNotification = class(TObject)
private
fNotificationMsg: Cardinal;
fNotificationRequest: integer;
fNotificationWnd: HWND;
fOnNotify: TNotifyEvent;
procedure DoNotify;
procedure NotificationWndMethod(var AMsg: TMessage);
public
constructor Create;
destructor Destroy; override;
procedure RequestNotification;
public
property OnNotify: TNotifyEvent read fOnNotify write fOnNotify;
end;
constructor TMainThreadNotification.Create;
begin
inherited Create;
fNotificationMsg := RegisterWindowMessage('thrd_notification_msg');
fNotificationRequest := -1;
fNotificationWnd := AllocateHWnd(NotificationWndMethod);
end;
destructor TMainThreadNotification.Destroy;
begin
if IsWindow(fNotificationWnd) then
DeallocateHWnd(fNotificationWnd);
inherited Destroy;
end;
procedure TMainThreadNotification.DoNotify;
begin
if Assigned(fOnNotify) then
fOnNotify(Self);
end;
procedure TMainThreadNotification.NotificationWndMethod(var AMsg: TMessage);
begin
if AMsg.Msg = fNotificationMsg then begin
SetTimer(fNotificationWnd, 42, 10, nil);
// set to 0, so no new message will be posted
InterlockedExchange(fNotificationRequest, 0);
DoNotify;
AMsg.Result := 1;
end else if AMsg.Msg = WM_TIMER then begin
if InterlockedExchange(fNotificationRequest, 0) = 0 then begin
// set to -1, so new message can be posted
InterlockedExchange(fNotificationRequest, -1);
// and kill timer
KillTimer(fNotificationWnd, 42);
end else begin
// new notifications have been requested - keep timer enabled
DoNotify;
end;
AMsg.Result := 1;
end else begin
with AMsg do
Result := DefWindowProc(fNotificationWnd, Msg, WParam, LParam);
end;
end;
procedure TMainThreadNotification.RequestNotification;
begin
if IsWindow(fNotificationWnd) then begin
if InterlockedIncrement(fNotificationRequest) = 0 then
PostMessage(fNotificationWnd, fNotificationMsg, 0, 0);
end;
end;
An instance of the class can be added to TLogTarget, to call a notification event in the main thread, but at most a few dozen times per second.
Consider replacing Synchronize with a call to PostMessage and handle this message in the form to add a log message to the memo. Something along the lines of: (take it as pseudo-code)
WM_LOG = WM_USER + 1;
...
MyForm = class (TForm)
procedure LogHandler (var Msg : Tmessage); message WM_LOG;
end;
...
PostMessage (Application.MainForm.Handle, WM_LOG, 0, PChar (LogStr));
That avoids all the deadlock problems of two threads waiting for each other.
EDIT (Thanks to Serg for the hint): Note that passing the string in the described way is not safe since the string may be destroyed before the VCL thread uses it. As I mentioned - this was only intended to be pseudocode.
Add mutex object to main thread. Get mutex when try close form. In other thread check mutex before synchronizing in processing sequence.
It's simple:
TMyThread = class(TThread)
protected
FIsIdle: boolean;
procedure Execute; override;
procedure MyMethod;
public
property IsIdle : boolean read FIsIdle write FIsIdle; //you should use critical section to read/write it
end;
procedure TMyThread.Execute;
begin
try
while not Terminated do
begin
Synchronize(MyMethod);
Sleep(100);
end;
finally
IsIdle := true;
end;
end;
//thread destroy;
lMyThread.Terminate;
while not lMyThread.IsIdle do
begin
CheckSynchronize;
Sleep(50);
end;
Delphi's TThread object (and inheriting classes) already calls WaitFor when destroying, but it depends on whether you created the thread with CreateSuspended or not. If you are using CreateSuspended=true to perform extra initialization before calling the first Resume, you should consider creating your own constructor (calling inherited Create(false);) that performs the extra initialization.
i'm writing a delphi app that communicates with excel. one thing i noticed is that if i call the Save method on the Excel workbook object, it can appear to hang because excel has a dialog box open for the user. i'm using the late binding.
i'd like for my app to be able to notice when Save takes several seconds and then take some kind of action like show a dialog box telling this is what's happening.
i figured this'd be fairly easy. all i'd need to do is create a thread that calls Save and have that thread call Excel's Save routine. if it takes too long, i can take some action.
procedure TOfficeConnect.Save;
var
Thread:TOfficeHangThread;
begin
// spin off as thread so we can control timeout
Thread:=TOfficeSaveThread.Create(m_vExcelWorkbook);
if WaitForSingleObject(Thread.Handle, 5 {s} * 1000 {ms/s})=WAIT_TIMEOUT then
begin
Thread.FreeOnTerminate:=true;
raise Exception.Create(_('The Office spreadsheet program seems to be busy.'));
end;
Thread.Free;
end;
TOfficeSaveThread = class(TThread)
private
{ Private declarations }
m_vExcelWorkbook:variant;
protected
procedure Execute; override;
procedure DoSave;
public
constructor Create(vExcelWorkbook:variant);
end;
{ TOfficeSaveThread }
constructor TOfficeSaveThread.Create(vExcelWorkbook:variant);
begin
inherited Create(true);
m_vExcelWorkbook:=vExcelWorkbook;
Resume;
end;
procedure TOfficeSaveThread.Execute;
begin
m_vExcelWorkbook.Save;
end;
i understand this problem happens because the OLE object was created from another thread (absolutely).
how can i get around this problem? most likely i'll need to "re-marshall" for this call somehow...
any ideas?
The real problem here is that Office applications aren't intended for multithreaded use. Because there can be any number of client applications issuing commands through COM, those commands are serialized to calls and processed one by one. But sometimes Office is in a state where it doesn't accept new calls (for example when it is displaying a modal dialog) and your call gets rejected (giving you the "Call was rejected by callee"-error). See also the answer of Geoff Darst in this thread.
What you need to do is implement a IMessageFilter and take care of your calls being rejected. I did it like this:
function TIMessageFilterImpl.HandleInComingCall(dwCallType: Integer;
htaskCaller: HTASK; dwTickCount: Integer;
lpInterfaceInfo: PInterfaceInfo): Integer;
begin
Result := SERVERCALL_ISHANDLED;
end;
function TIMessageFilterImpl.MessagePending(htaskCallee: HTASK;
dwTickCount, dwPendingType: Integer): Integer;
begin
Result := PENDINGMSG_WAITDEFPROCESS;
end;
function ShouldCancel(aTask: HTASK; aWaitTime: Integer): Boolean;
var
lBusy: tagOLEUIBUSYA;
begin
FillChar(lBusy, SizeOf(tagOLEUIBUSYA), 0);
lBusy.cbStruct := SizeOf(tagOLEUIBUSYA);
lBusy.hWndOwner := Application.Handle;
if aWaitTime < 20000 then //enable cancel button after 20 seconds
lBusy.dwFlags := BZ_NOTRESPONDINGDIALOG;
lBusy.task := aTask;
Result := OleUIBusy(lBusy) = OLEUI_CANCEL;
end;
function TIMessageFilterImpl.RetryRejectedCall(htaskCallee: HTASK;
dwTickCount, dwRejectType: Integer): Integer;
begin
if dwRejectType = SERVERCALL_RETRYLATER then
begin
if dwTickCount > 10000 then //show Busy dialog after 10 seconds
begin
if ShouldCancel(htaskCallee, dwTickCount) then
Result := -1
else
Result := 100;
end
else
Result := 100; //value between 0 and 99 means 'try again immediatly', value >= 100 means wait this amount of milliseconds before trying again
end
else
begin
Result := -1; //cancel
end;
end;
The messagefilter has to be registered on the same thread as the one issuing the COM calls. My messagefilter implementation will wait 10 seconds before displaying the standard OLEUiBusy dialog. This dialog gives you the option to retry the rejected call (in your case Save) or switch to the blocking application (Excel displaying the modal dialog).
After 20 seconds of blocking, the cancel button will be enabled. Clicking the cancel button will cause your Save call to fail.
So forget messing around with threads and implement the messagefilter, which is the way
to deal with these issues.
Edit:
The above fixes "Call was rejected by callee" errors, but you have a Save that hangs. I suspect that Save brings up a popup that needs your attention (Does your workbook has a filename already?). If it is a popup that is in the way, try the following (not in a separate thread!):
{ Turn off Messageboxes etc. }
m_vExcelWorkbook.Application.DisplayAlerts := False;
try
{ Saves the workbook as a xls file with the name 'c:\test.xls' }
m_vExcelWorkbook.SaveAs('c:\test.xls', xlWorkbookNormal);
finally
{ Turn on Messageboxes again }
m_vExcelWorkbook.Application.DisplayAlerts := True;
end;
Also try to debug with Application.Visible := True; If there are any popups, there is a change you will see them and take actions to prevent them in the future.
Rather than accessing the COM object from two threads, just show the message dialog in the secondary thread. The VCL isn't thread-safe, but Windows is.
type
TOfficeHungThread = class(TThread)
private
FTerminateEvent: TEvent;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure Terminate; override;
end;
...
constructor TOfficeHungThread.Create;
begin
inherited Create(True);
FTerminateEvent := TSimpleEvent.Create;
Resume;
end;
destructor TOfficeHungThread.Destroy;
begin
FTerminateEvent.Free;
inherited;
end;
procedure TOfficeHungThread.Execute;
begin
if FTerminateEvent.WaitFor(5000) = wrTimeout then
MessageBox(Application.MainForm.Handle, 'The Office spreadsheet program seems to be busy.', nil, MB_OK);
end;
procedure TOfficeHungThread.Terminate;
begin
FTerminateEvent.SetEvent;
end;
...
procedure TMainForm.Save;
var
Thread: TOfficeHungThread;
begin
Thread := TOfficeHungThread.Create;
try
m_vExcelWorkbook.Save;
Thread.Terminate;
Thread.WaitFor;
finally
Thread.Free;
end;
end;
Try calling CoInitializeEx with COINIT_MULTITHREADED since MSDN states:
Multi-threading (also called free-threading) allows calls to methods of objects created by this thread to be run on any thread.
'Marshalling' an interface from one thread to another can be done by using CoMarshalInterThreadInterfaceInStream to put the interface into a stream, move the stream to the other thread and then use CoGetInterfaceAndReleaseStream to get the interface back from the stream. see here for an example in Delphi.
Lars' answer is along the right lines I think. An alternative to his suggestion is to use the GIT (Global Interface Table), which can be used as a cross-thread repository for interfaces.
See this SO thread here for code for interacting with the GIT, where I posted a Delphi unit that provides simple access to the GIT.
It should simply be a question of registering your Excel interface into the GIT from your main thread, and then getting a separate reference to the interface from within your TOfficeHangThread thread using the GetInterfaceFromGlobal method.