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.
Related
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;
I have some codes here:
procedure TForm1.Button1Click(Sender: TObject);
begin
//Some Codes(1)
Sample;
//Some Codes(2)
end;
Function Sample();
begin
sleep(5000);
end;
In this code, after //Somecodes(1) Application goes to Sample function and waits for 5 seconds then it runs //Somecodes(2) right? It means for Unfreezing Button1 we have to wait for more than 5 Seconds.
Now I want to do something that when the application runs //Some Codes(1) and Sample, Immediately goes to the next line (//Somecodes(2)) so I don't need to wait for 5 seconds to button 1 Unfreez.
How can I do it?
Like Andreas said, you can use threads for this. You might use them with an anonymous procedure like this: (Note: TThread.CreateAnonymousThread appears not to exist yet in Delphi 2010. I address this problem below.)
procedure TForm1.Button1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
begin
// Chunk of code 1
Sleep(5000);
MessageBox(0, 'x', 'x', MB_OK);
end).Start;
TThread.CreateAnonymousThread(
procedure
begin
// Chunk of code 2
Sleep(5000);
MessageBox(0, 'y', 'y', MB_OK);
end).Start;
end;
You can also implement your own thread class, but using CreateAnonymousThread you can just pass a procedure that is executed in the thread. You can call Start (or Run) to run the thread immediately, and threads created using CreateAnonymousThread free themselves when they are done.
So, both chunks of code will run simultaneously. That means that after 5 seconds you will get two popups right after each other (you can drag aside the topmost to see the other). Also, the button will be responsive directly after it is clicked, while the sleeps are running in the background.
Note though that most of the VCL is not thread safe, so you should be careful not to modify (visual) components in these threads.
about thread safety
Like J... mentioned in the comments, it's not just the VCL that is not thread safe. Many code is not, and also your own code needs to be aware of this.
For instance if I modify the code above slightly, I can let both threads count to a billion and increment a shared integer. You'd expect the integer to reach 2 billion by the time the threads are done, but in my test it reaches just over one billion. That is because both threads are updating the same integer at the same time, overwriting the attempt of the other thread.
procedure TForm6.FormCreate(Sender: TObject);
var
n: Integer;
begin
n := 0;
TThread.CreateAnonymousThread(
procedure
var i: Integer;
begin
for i := 0 to 1000000000 do
Inc(n);
MessageBox(0, 'x', 'x', MB_OK);
end).Start;
TThread.CreateAnonymousThread(
procedure
var i: Integer;
begin
for i := 0 to 1000000000 do
Inc(n);
MessageBox(0, 'y', 'y', MB_OK);
end).Start;
Sleep(10000); // Make sure this is long enough. The number should appear later than 'x' and 'y'.
ShowMessage(IntToStr(n));
end;
To fix this, you can either synchronize the updating (execute it in the main thread), or use critical sections to lock the updates. In cases where you are actually just updating in integer, you can also use the InterlockedIncrement function. I will not explain these further, because there's plenty of proper documentation and it's beyond the scope of this answer.
Note though, that each of these methods slows down your application by executing the pieces of code after each other instead of simultaneously. You are effectively making the threads wait for each other. Nevertheless, threads are still useful, if you can finetune them so that only small pieces need to be synchronised.
TThread.CreateAnonymousThread in Delphi 2010
TThread.CreateAnonymousThread just creates an instance of TAnonymousThread, a specific thread class that executes a given procedure.
Since TThread.CreateAnonymousThread doesn't exist in Delphi 2010, you can just call it like this:
TAnonymousThread.Create(
procedure
var i: Integer;
begin
for i := 0 to 1000000000 do
Inc(n);
MessageBox(0, 'x', 'x', MB_OK);
end).Start;
I don't know if TAnonymousThread itself does exist in Delphi 2010, but if not, you can find it's code below. I hope Embarcadero doesn't mind me sharing it, but it's actually just four simple lines of code.
This class you could just as easy create yourself, but it is declared like below. The constructor takes a single parameter, which is the procedure to execute. It also sets a property that makes the thread free itself when done. The execute method just executes the given procedure.
type
TAnonymousThread = class(TThread)
private
FProc: TProc;
protected
procedure Execute; override;
public
constructor Create(const AProc: TProc);
end;
constructor TAnonymousThread.Create(const AProc: TProc);
begin
inherited Create(True);
FreeOnTerminate := True;
FProc := AProc;
end;
procedure TAnonymousThread.Execute;
begin
FProc();
end;
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.
How to catch the start and completion of applications (processes) in Win.
How to measure the time of each application?
You can use the GetProcessTimes function to get timing information for a particular process.
BOOL WINAPI GetProcessTimes(
__in HANDLE hProcess,
__out LPFILETIME lpCreationTime,
__out LPFILETIME lpExitTime,
__out LPFILETIME lpKernelTime,
__out LPFILETIME lpUserTime
);
See this example
program GetProcessTime;
{$APPTYPE CONSOLE}
uses
DateUtils,
Windows,
tlhelp32,
SysUtils;
Procedure GetAllProcessTime;
var
HandleSnapShot : THandle;
EntryParentProc : TProcessEntry32;
DummyCreateFileTime : Windows.FILETIME;
DummyExitFileTime : Windows.FILETIME;
DummyKernelFileTime : Windows.FILETIME;
DummyUserFileTime : Windows.FILETIME;
aFileName : String;
h : THandle;
ActualTime : TDateTime;
Dif : TDateTime;
CreationTime : TDateTime;
function FileTime2DateTime(FileTime: TFileTime): TDateTime; //Convert then FileTime to TDatetime format
var
LocalTime: TFileTime;
DOSTime : Integer;
begin
FileTimeToLocalFileTime(FileTime, LocalTime);
FileTimeToDosDateTime(LocalTime, LongRec(DOSTime).Hi, LongRec(DOSTime).Lo);
Result := FileDateToDateTime(DOSTime);
end;
begin
HandleSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //get the list of process
if HandleSnapShot <> INVALID_HANDLE_VALUE then
begin
EntryParentProc.dwSize := SizeOf(EntryParentProc);
if Process32First(HandleSnapShot, EntryParentProc) then //Get the first process in the list
begin
Writeln( Format('%-30s %-20s %-16s',['FileName','Start','Running Time']) );
ActualTime:=Now;
repeat
h:=OpenProcess(PROCESS_QUERY_INFORMATION,false,EntryParentProc.th32ProcessID); //open a particular process
if GetProcessTimes(h, DummyCreateFileTime, DummyExitFileTime, DummyKernelFileTime, DummyUserFileTime) then //get the timing info
begin
aFileName:=ExtractFileName(EntryParentProc.szExeFile);
CreationTime:=FileTime2DateTime(DummyCreateFileTime); //get the initial time of the process
Dif := ActualTime-CreationTime; //calculate the elapsed time
Writeln( Format('%-30s %-20s %-16s',[aFileName,FormatDateTime('DD-MM-YYYY HH:NN:SS',CreationTime),FormatDateTime('HH:NN:SS',Dif)]) );
end;
CloseHandle(h);
until not Process32Next(HandleSnapShot, EntryParentProc);
end;
CloseHandle(HandleSnapShot);
end;
end;
begin
try
GetAllProcessTime();
Readln;
except
on E: Exception do
begin
Writeln(E.ClassName, ': ', E.Message);
Readln;
end;
end;
end.
There are a couple or so Windows API calls with 'hook' in the name that allow you to capture systemwide events. You'll have to build those into a DLL, and then make calls to the 'hooking' DLL from a separate application.
That, VERY briefly, is it. Hope that gets you started!
Windows Performance Analyzer has features specifically for timing applications from the moment they start, even if they're in the boot or log-in sequence.
the WH_CBT hook is most likely the one you are after. It allows you to be notified by the OS whenever a window is created or destroyed. You will want to use this hook to grab the handle and from the handle get the process id using GetWindowThreadProcessId. You can then pass this handle to the function GetProcessTimes (suggested by RRUZ) to get the times. An example (although dated, the concepts are still the same) is available in the GpSysHook source.
Windows Management Instrumentation offers event subscription. The nice thing with WMI is that it works remote too, using DCOM and SOAP.
WMI offers the capability to notify a subscriber for any event it is interested in.
WMI uses the WMI Query Language (WQL)
to submit WQL event queries and
defines the type of events to be
returned. The eventing mechanism, with
all related callbacks, is part of the
WMI COM/DCOM and automation
interfaces.
A free WMI client implementation for Delphi is available online (not sure if it supports event callbacks):
Magenta Systems WMI and SMART Component
My application sits in the system tray when it's not being used.
The user can configure events to occur at particular schedule. For example they may way the task performed mon-fri at 5pm or every wednesday at 3pm or on the 16th of every month at 10am.
Assuming my delphi program is always running, it starts at boot-up, what is the best way in delphi to support the triggering of these scheduled events.
Obviously a TTimer can be used to schedule events based on elapsed time but they don't seem suited to this problem.
Cheers
You can use my CRON compliant Cromis Scheduler (link to archive.org). It even supports some things that cron does not. Interval based events for instance and from / to timeframe. I use it in a lot of my software and it has proven itself quite useful. It is free, very lightweight, works in threads and is production tested. If you need any further help just mail me.
The other ways would be:
Use windows scheduling API as already suggested. But this may change between OS-es.
Use JCL that has a scheduler unit (component in the JVCL), but I found that one hard to use from code directly. That is why I wrote my own.
I would use the Microsoft Task Scheduler API for that:
http://msdn.microsoft.com/en-us/library/aa383614(VS.85).aspx
There are Delphi Wrappers available for the API if you don't want to do the "dirty work", but I don't know if there's a free one. You might have a look at
http://www.sicomponents.com/taskscheduler.html
http://www.torry.ru/pages.php?id=296
If you don't want to use the Microsoft Scheduler, there are things like the CronJob Component available here: http://www.appcontrols.com/components.html. It's shareware, too, but is easy to implement (just an onAlert event).
You need a scheduling component. There are many available, however I can't seem to find any free one. You can always build one yourself, based on TTimer, or try to access theTask Scheduling API.
However, having a timer that executes a task every minute to check if a task is due, is much simpler.
You could implement some kind of inter process communication in your program and trigger these events via ipc by a program called from the Windows scheduling service. This approach has the advantage that you don't need to write a user interface to set up the schedule and also that ipc might prove useful in other ways.
Since your application is running, you can use the idle event to see if a preset date/time has already elapsed and if so then to perform your timing. The only side effect of this approach is that your event won't fire if the application is busy, but then neither would a timer (for the TTimer to work the message queue needs to be processed, or the application needs to be "Idle" unless you use a threaded timer).
uses
...,DateUtils; // contains IncMinute
type
TForm1 = Class(TForm)
:
procedure FormCreate(Sender: TObject);
private
fTargetDate : tDateTime;
procedure AppIdle(Sender: TObject; var Done: Boolean);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fTargetDate := 0.0;
Application.OnIdle := AppIdle;
fTargetDate := IncMinute(Now,2);
end;
procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
if (fTargetDate <> 0.0) and (Now >= fTargetDate) then
begin
fTargetDate := 0.0;
ShowMessage('started');
end;
end;
EDIT If you have multiple times you need to run something, place in an ordered list by date/time and then only track the NEXT time something will run. As something is run, it is removed for the list (or rescheduled back into the list and the list re-sorted).
Another option would be to create a TThread which performs the management of the timer:
type
TestThreadMsg = class(tThread)
private
fTargetDate : tDateTime;
fMsg : Cardinal;
protected
procedure Execute; override;
procedure NotifyApp;
public
constructor Create( TargetDate : TDateTime; Msg:Cardinal);
end;
implementation:
constructor TestThreadMsg.Create(TargetDate: TDateTime; Msg: Cardinal);
begin
inherited Create(True);
FreeOnTerminate := true;
fTargetDate := TargetDate;
fMsg := Msg;
Suspended := false;
end;
procedure TestThreadMsg.Execute;
begin
Repeat
if Terminated then exit;
if Now >= fTargetDate then
begin
Synchronize(NotifyApp);
exit;
end;
Sleep(1000); // sleep for 1 second, resoultion = seconds
Until false;
end;
procedure TestThreadMsg.NotifyApp;
begin
SendMessage(Application.MainForm.Handle,fMsg,0,0);
end;
Which can then be hooked up to the main form:
const
WM_TestTime = WM_USER + 1;
TForm1 = Class(TForm)
:
procedure FormCreate(Sender: TObject);
procedure WMTestTime(var Msg:tMessage); message WM_TestTime;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
TestThreadMsg.Create(IncSecond(Now,5),WM_TestTime);
end;
procedure TForm1.WMTestTime(var Msg: tMessage);
begin
ShowMessage('Event from Thread');
end;