working with a Windows Service application in Delphi, I stumbled on the issue as in the subject.
I do start a default Delphi Windows Service project on the IDE, follow the wizard and in the end I have a project and a
TService unit. I add to this project another unit, a Data Module (named DM) in which the service code logic is contained.
The DM has a TTimer (design-time) that runs a relatively long job.
Case 1:
DM is created by default in design-time. I have the following code in my TService Start/Stop
procedure TOmegaCAOraNT.ServiceStart(Sender: TService;
var Started: Boolean);
begin
DM.Timer1.Enabled := True;
Started := true;
end;
procedure TOmegaCAOraNT.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
DM.Agent_Stop;
Stopped := true;
end;
When I try to Stop the Service via Windows SCM - in appearance it confirms the Stop, field Status becomes empty - but it does not.
I can see the service .exe still running for a while, and what's more it does terminate the Timer's long job in the middle,
doing part of it only!
This is an undesired behavior!
I fixed this in the second case
Case 2:
DM is created in run-time. The Timer is enabled on DM.OnCreate
I have the following code in my TService Start/Stop
procedure TOmegaCAOraNT.ServiceStart(Sender: TService; var Started: Boolean);
begin
FDataModule := TDM.Create(nil);
Started := true;
end;
procedure TOmegaCAOraNT.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
FreeAndNil(FDataModule);
Stopped := true;
end;
When I try to Stop the Service via Windows SCM - it throws the following Warning:
"Windows could not stop the SERVICE> service on the Local Computer.
The service did not return an error. his could be an internal Windows error or an internal service error.
if the error persists, contact your system Administrator"
field Status remains Started. Timer' long job finishes until the end, and then the service really stops (refresh in SCM to see, Status empty)
This is desired behavior !
My problem is that I would like the DM to be created in design-time, and not in run-time
My question is:
can I have the right behavior of run-time DM (Case 2), with a design-time DM (Case 1) ?
thanks and best regards,
Altin
TService runs in is own worker thread at run-time.
If you configure the DM to be auto-created, it (and its TTimer) will be created in the main thread at run-time, not in the service thread. And thus, the TTimer will run in the main thread, and can be activated only by the main thread, not in the TService.OnStart event handler (an EOutOfResources exception will be raised if you try).
If you manually create the DM in the TService.OnStart event handler, it (and its TTimer) will be created in the service thread, not in the main thread. The TTimer will run in the service thread, and can be (de)activated in the TService events.
Either way, make sure your TTimer.OnTimer event handler uses thread-safe code.
Also, the TService.OnStop event handler must call the TService.ReportStatus() method periodically (before the TService.WaitHint interval elapses) while waiting for other threads to stop whatever they are doing. Which means you shouldn't use thread-blocking code in the TService.OnStop event handler.
You are not handling this correctly, which is why the SCM is having problems.
Related
I`m developing a service application with COM-object in it (OPC Data Access 2.05 server). I have this code for registration my object, which is executed after installation:
procedure TOPCService.ServiceAfterInstall(Sender: TService);
var
lcHResult: HRESULT;
lcCLSIDString: String;
begin
ComServer.UpdateRegistry(True);
lcCLSIDString:=GUIDToString(CLASS_TestOPCServerDA2);
ComObj.CreateRegKey('AppID\'+lcCLSIDString, '', 'Test OPC Server DA2');
ComObj.CreateRegKey('AppID\'+Application.ExeName, 'AppId', lcCLSIDString);
ComObj.CreateRegKey('CLSID\'+lcCLSIDString+'\VersionIndependentProgID', '', C_TEST_OPC_DA2_SERVER_NAME);
<opc server registration stuff>
RegisterAsService(lcCLSIDString, Name);
end;
The service and COM-object are properly register in the system, so i can see my service in SCM and COM-object in OLE/COM object viewer (and also in OPC clients).
The COM-object itself looks like this:
type
TTestOPCServerDA2 = class(TAutoObject, ITestOPCServerDA2, IConnectionPointContainer, IOPCServer, IOPCCommon, IOPCItemProperties, IOPCBrowseServerAddressSpace)
with its factory registration code:
initialization
TAutoObjectFactory.Create(ComServer, TTestOPCServerDA2, Class_TestOPCServerDA2, ciMultiInstance, tmApartment);
The problem is when i try to CoCreateInstance(CLASS_TestOPCServerDA2) (via CreateComObject wrapper), i got freeze for 120 second and 0x80080005 (CO_E_SERVER_EXEC_FAILURE) error after. In SCM and Task Manager i see my service is started when COM-object is requested, but nothing else happens. If i stop the serivce and try againg, service would be started again, so i assume Windows knows about my COM-object, its executable and the fact that executable is a service.
I also tried to change user which my service is running under (to the same with the invoking application), but that did not help.
What am i missing?
Edit 1. I created new project and got rid of OPC (just left COM support) to isolate the problem, so now my class is looks like this:
type
TTestCOMServer = class(TAutoObject, ITestCOMServer)
end;
...
initialization
TAutoObjectFactory.Create(ComServer, TTestCOMServer, Class_TestCOMServer, ciMultiInstance, tmApartment);
And the service thread:
procedure TCOMService.ServiceExecute(Sender: TService);
begin
while (not Terminated) do
begin
ReportStatus;
ServiceThread.ProcessRequests(False);
Sleep(25);
end;
The problem persists: when i try to CoCreateInstance, nothing happens and calling app hangs for 120 seconds.
But! If i make 1 change: uncommenting Application.DelayInitialize := True; in dpr, COM-object gets created well and calling app freezes no longer! Is it the service execute thread that (not service main thread) processes COM-requests?
Edit 2. It seems that only DelayInititalization is requred. ProcessRequests can be called with False argument and sleep can have its place - i must have not properly rebuilded my project.
So, i think the answer to my question is to uncomment Application.DelayInitialize := True; in DPR-file. Delphi autogenerate text about that, but it mentions only Windows 2003 Server condition and my OS is Windows 10.
In my case (Delphi XE3 under Windows 10 Pro) i had to uncomment
Application.DelayInitialize := True;
in DPR. After this change, COM-object is created properly.
I have a problem that code inside my dll is acting different compared to the same code within a normal application. After some debugging I found that the thread's OnTerminate is never called within the dll.
type
TTest = class
private
public
procedure threadStart();
procedure threadEnd(Sender: TObject);
procedure lines(value: String);
end;
procedure TTest.threadStart();
var aThread : TThread;
begin
aThread :=
TThread.CreateAnonymousThread(
procedure
begin
lines('start')
end
);
aThread.FreeOnTerminate := True;
aThread.OnTerminate := self.threadEnd;
aThread.Start;
end;
procedure TTest.threadEnd;
begin
lines('end')
end;
procedure TTest.lines(value: String);
var MyText: TStringlist;
begin
MyText:= TStringlist.create;
MyText.Add(value);
MyText.SaveToFile('.\filename.txt');
MyText.Free
end;
If I run this code from a normal VLC Delphi Application, I get end in the text file.
If I run the same code from a dll (loading it either static or dynamic into a VLC Application), I get start in the text file.
My question: Why? Or better asked, how can I let my dll act the same way as my VLC. Current version I'm using is XE7.
The TThread.OnTerminate event is triggered in the context of the main UI thread via a call to TThread.Synchronize(), which stores requests in a queue that the main UI thread checks periodically, executing pending requests when available.
If the DLL and EXE are compiled with Runtime Packages enabled, they share a single copy of the RTL (and thus require you to deploy rtl.bpl with your app). When the EXE checks the RTL's Synchronize() queue, it will see pending requests from both EXE and DLL.
However, if they are not sharing a single RTL, then they will be compiled with separate copies of the RTL that are not linked to each other. By default, there is nothing in the EXE that checks and processes pending requests from the DLL's Synchronize() queue, only from the EXE's Synchronize() queue. To address that, you have to export a function from the DLL that calls the CheckSynchronize() function of the DLL's RTL, and then make the EXE call that exported DLL function periodically, such as in a timer.
Otherwise, the other way to get around this problem is to bypass the Synchronize() call that triggers the OnTerminate event, by overriding the thread's virtual DoTerminate() method (which you cannot do with TThread.CreateAnonymousThread()). You can have DoTerminate() call OnTerminate directly, or just do what you need inside of DoTerminate() itself. But either way, you have to make sure this code is thread safe, as DoTerminate() runs in the context of the worker thread.
I am trying to prevent my application from being shutdown by windows.
The application is running on windows 8 and written in XE6.
I tried following code but it seems to be completely ignored. To test it I simply send "end task" to it through the task manager.
What I need is a way to let my application finish what its doing when the application is closed by the user, by the task manager of by a windows shutdown.
Normal closing is not a problem, this is handled by the FormCloseQuery event. But the other 2 methods I can't get to work. Until windows XP this was easy by catching the wm_endsession and the wm_queryendsession, starting from vista you need the use ShutDownBlockReasonCreate, which returns true but does not seems to work anyway.
procedure WMQueryEndSession(var Msg : TWMQueryEndSession); message WM_QUERYENDSESSION;
procedure WMEndSession(var Msg: TWMEndSession); message WM_ENDSESSION;
function ShutdownBlockReasonCreate(hWnd: HWND; Reason: LPCWSTR): Bool; stdcall; external user32;
function ShutdownBlockReasonDestroy(hWnd: HWND): Bool; stdcall; external user32;
procedure TForm1.WMEndSession(var Msg: TWMEndSession);
begin
inherited;
Msg.Result := lresult(False);
ShutdownBlockReasonCreate(Handle, 'please wait while muting...');
Sleep(45000); // do your work here
ShutdownBlockReasonDestroy(Handle);
end;
procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
inherited;
Msg.Result := lresult(False);
ShutdownBlockReasonCreate(Handle, 'please wait while muting...');
Sleep(45000); // do your work here
ShutdownBlockReasonDestroy(Handle);
end;
Update
Changing the message result to true and removing the sleep changes nothing.
procedure TForm1.WMEndSession(var Msg: TWMEndSession);
begin
inherited;
Msg.Result := lresult(True);
ShutdownBlockReasonDestroy(Application.MainForm.Handle);
ShutdownBlockReasonCreate(Application.MainForm.Handle, 'please wait while muting...');
end;
procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
inherited;
Msg.Result := lresult(True);
ShutdownBlockReasonDestroy(Application.MainForm.Handle);
ShutdownBlockReasonCreate(Application.MainForm.Handle, 'please wait while muting...');
end;
According to the documentation to block shutdown you need to return FALSE in response to WM_QUERYENDSESSION.
What's more, you must not do work in this message handler. The work must happen elsewhere. If you don't respond to this message in a timely fashion the system won't wait for you.
Call ShutdownBlockReasonCreate before you start working.
Whilst working return FALSE from WM_QUERYENDSESSION. Don't work whilst handling this message. Return immediately.
When the work is done call ShutdownBlockReasonDestroy.
The handler for WM_QUERYENDSESSION can look like this:
procedure TMainForm.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
if Working then
Msg.Result := 0
else
inherited;
end;
And then the code that performs the work needs to call ShutdownBlockReasonCreate before the work starts, ShutdownBlockReasonDestroy when the work ends, and make sure that the Working property used above evaluates to True during work.
If your work blocks the main thread then you are in trouble. The main thread must be responsive, otherwise the system won't wait for you. Putting the work in a thread is often the way forward. If your main window is not visible then you don't get a chance to block shutdown. The details are explained here: http://msdn.microsoft.com/en-us/library/ms700677.aspx
If you get as far as being sent WM_ENDSESSION then it's too late. The system is going down come what may.
To test it I simply send "end task" to it through the task manager.
That has nothing to do with shutdown blocking. The way you test shutdown blocking is to logoff. If the user insists on killing your process there is little that you can do about it. Sertac's answer covers this in detail.
Finally, ignoring the return values of API calls is also very poor form. Don't do that.
Your code seems to be completely ignored because you're not testing it. You're sending "end task" to it through the task manager, the code you posted is only effective when the system is shutting down.
What is different with Windows 8 seems to be how task manager behaves. Before Windows 8, an end task from task manager will first try closing the app gracefully (sends a WM_CLOSE), this you're handling with OnCloseQuery. But when the application denies closing, the task manager will offer ending the process forcefully. This, you cannot handle. Same if you choose "end process" from task manager.
The Windows 8 task manager does not offer an additional dialog for forcefully closing the application, but immediately proceeds doing so when the application denies closing.
Here are some solution for some different cases tested in Delphi 11.1 Alexandria:
The Form OnCloseQuery gets called when app is being closed by user or by system shutdown, to know which one of these two events is triggered, call GetSystemMetrics and pass SM_SHUTTINGDOWN as an argument.
System metric SM_SHUTTINGDOWN is set when there is a pending system shutdown, clear otherwise.
This is all you need if you only want say suppress exit confirmation message to the user if system is shutting down:
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if GetSystemMetrics (SM_SHUTTINGDOWN) > 0 then
Exit; // app is being closed by a system shutdown
// app being closed by user, ask user to confirm exit
if not ConfirmAppExit then
CanClose := False;
end;
Please note if the system is shutting down your Form OnCloseQuery will be called but your Form OnClose will not be called, any code you put in OnClose will not be executed. So, don't put code there if you want it to be executed on system shutdown, Instead, use the WM_EndSession handler described below.
If you want more than that and be able to block the shutdown, First write a handler for the message WM_QueryEndSession:
procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QueryEndSession;
Inside this handler do not do anything except returning message result, this message is sent to your app to check if it agrees to shutdown the system or not, it does not mean the system shutdown is taking place right now, because all apps must agree to this message first, but if just one app denies this message (return False) then shutdown will not happen (When shutdown is really
taking place you will receive WM_EndSession message).
In the WM_QueryEndSession handler check if there are any critical running tasks which must be completed in one go or if interrupted will cause data loss, If there is a critical task running return False to deny system shutdown, like:
procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
if CriticalTaskRunning then
Msg.Result := 0 // Deny system shutdown
else
inherited; // Agree to system shutdown, Same as Msg.Result := 1
end;
Do not return False if your task is not critical and can be interrupted, and do not interrupt your task at this point, just return True and keep your task running because some other app may deny the shutdown and you just interrupted your task for nothing!, Interrupt your task only when you receive WM_EndSession message which means all applications agreed to the shutdown and the system is really shutting down.
By returning False, shutdown is now denied, using ShutdownBlockReasonCreat at this time is redundant, but you can use that to explain to the user (in shutdown screen) why your app is blocking shutdown. If you use this be sure to call ShutdownBlockReasonDestroy after your task is finished.
When receiving WM_EndSession you know now the system is really shutting down.
If you need to do cleanup, abort any running tasks, save changes close DB/files ...etc, then you can use ShutdownBlockReasonCreate to block shutdown until you finish cleaning up, then unblock shutdown once finished, like:
procedure WMEndSession (var Msg: TWMEndSession);
begin
if CleanUpRequired then
begin
ShutdownBlockReasonCreate (Handle, 'My app is preparing to close, just a sec...');
try
DoCleanUp;
finally
ShutdownBlockReasonDestroy (Handle);
end;
end;
end;
Some other shutdown block methods suggest you create a shutdown block every time you start a task and destroy the shutdown block once your task is finished even if the system is not shutting down! my approach here is only create a shutdown block when it is necessary and only when the system is really shutting down.
I Hope it's useful for someone!
At program start, in the OnActivate event handler, I need to do something which blocks the program for a few seconds. During this time the form's client area is still not completely painted, which looks ugly for the user. (During this blocked time I don't need the program to respond to clicks or other user actions, so there is no need to put the blocking operation into a thread - I just need the form to be completely painted). So I use TForm.Update and Application-ProcessMessages to update the form before the blocking operation which works very well:
procedure TForm1.FormActivate(Sender: TObject);
begin
Form1.Update;
Application.ProcessMessages;
Sleep(7000);
end;
However, I wonder whether there is not another more elegant solution for this problem. This could be for example a OnShown event implemented in a descendant of TForm which will be fired AFTER the form has been completely painted. How could such an event be implemented?
Your real problem is that you are blocking the UI thread. Simply put, you must never do that. Move the long running task onto a different thread and thus allow the UI to remain responsive.
If you are looking for event which is fired when application finishes loading/repainting you should use TApplication.OnIdle event
http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Forms.TApplication.OnIdle
This event is fired once application is read to recieve users input. NOTE this event will be fired every time application becomes idle so you need to implement some controll variable which will tel you when OnIdle even was fired for the first time.
But as David already pointed out it is not good to block your UI (main thread). Why? When you block your main thread the application can't normally process its messages. This could lead to OS recognizing your application as being "Hanged". And aou definitly wanna avoid this becouse it could cause the users to go and forcefully kill your application whihc would probably lead to data loss. Also if you ever wanna design your application for any other platforms than Windows your application might fail the certification proces becouse of that.
In the past a simple PostMessage did the trick.
Essentially you fire it during DoShow of the base form:
procedure TBaseForm.DoShow;
begin
inherited;
PostMessage(Handle, APP_AFTERSHOW, 0, 0);
end;
then catch the msg and create an AfterShow event for all forms inherited from this base form.
But that no longer works, well not if you are skinning and have a good number of VCL controls.
My next trick was to spawn a simple thread in DoShow and check for IsWindowVisible(Handle) and IsWindowEnabled(Handle). That really sped things up it cut 250ms from load time since db opening and other stuff was already in the AfterShow event.
Then finally I thought of madHooks, easy enough to hook the API ShowWindow for my application and fire APP_AFTERSHOW from that.
function ShowWindowCB(hWnd: HWND; nCmdShow: Integer): BOOL; stdcall;
begin
Result := ShowWindowNext(hWnd, nCmdShow);
PostMessage(hWnd, APP_AFTERSHOW, 0, 0);
end;
procedure TBaseForm.Loaded;
begin
inherited;
if not Assigned(Application.MainForm) then // Must be Mainform it gets assigned after creation completes
HookAPI(user32, 'ShowWindow', #ShowWindowCB, #ShowWindowNext);
end;
To get the whole thing to completely paint before AfterShow it still needed a ProcessPaintMessages call
procedure TBaseForm.APPAFTERSHOW(var AMessage: TMessage);
begin
ProcessPaintMessages;
AfterShow;
end;
procedure ProcessPaintMessages; // << not tested, pulled out of code
var
msg: TMsg;
begin
while PeekMessage(msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do
DispatchMessage(msg);
end;
My final test was to add a Sleep to the AfterShow event and see the Form fully painted with empty db containers since the AfterShow events had not yet completed.
procedure TMainForm.AfterShow;
begin
inherited;
Sleep(8*1000);
......
I have a Windows service written in Delphi. One of the third-party resources it uses occasionally gets corrupted, and the only way I've found to fix the situation is to exit and restart the program. I can detect when the resource is corrupted from within the program, and I can tell Windows to restart the service after it stops, but I can't figure out how to have the service tell itself to stop.
The program is pretty simple. I created a service application in what seems to be the normal way. I have a subclass of TService to manage the service, while all of the functionality occurs in a separate thread. The TService subclass pretty much just manages the execution of the subthread, and it's in the subthread that I would be detecting the corruption.
For reference, here's the header info for the service and subthread.
type
TScannerThread = class(TThread)
private
Scanner : TScanner;
DefaultDir : String;
ImageDir : String;
procedure CheckScanner;
public
Parent : TComponent;
procedure Execute; override;
end;
TCardScanSvc = class(TService)
procedure ServiceCreate(Sender: TObject);
procedure ServiceExecute(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
private
ScannerThread : TScannerThread;
public
function GetServiceController: TServiceController; override;
end;
var
CardScanSvc : TCardScanSvc;
In a GUI application, I'd call Application.Terminate, but TServiceApplication doesn't seem to have that method. I can terminate the subthread, but the main thread never notices, and Windows thinks the service is still running. I can't really think of much else to try.
The program was originally created in Delphi 5, and I'm currently using Delphi 2007, in case that makes a difference.
Edit:
With mghie's code, I can stop the service, but Windows will only restart the service if it fails unexpectedly, not if it's stopped normally. What I'm going to do is make a separate service application, have the first signal the second if it has problems, and then have the second restart the first.
There is no problem having the service stop itself - I just tried with one of my own services, written with Delphi 4 (without using the TService class). The following routine works for me:
procedure TTestService.StopService;
var
Scm, Svc: SC_Handle;
Status: SERVICE_STATUS;
begin
Scm := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if Scm <> 0 then begin
Svc := OpenService(Scm, PChar(ServiceName), SERVICE_ALL_ACCESS);
if Svc <> 0 then begin
ControlService(Svc, SERVICE_CONTROL_STOP, Status);
// handle Status....
CloseServiceHandle(Svc);
end;
CloseServiceHandle(Scm);
end;
end;
You need to check whether it will also work from your worker thread.
You should be able to use WMI (Windows Management Instrumentation) to restart a service, even from within the service itself. Don't know if this would cause any strange problems but it should work. Here's an article on doing WMI with Delphi.
UPDATE: Well well, I assumed (my mistake) that there is a single WMI service restart command, such as the button you can click in the services maangement listing. Apparently not.
You could instead write a console app that the service starts when the data is corrupted. The console app would restart the service from a separate process.
I have found a simpler alternative that should work. You can add a method to your TService subclass:
procedure TSomeService.StopService;
begin
Controller(SERVICE_CONTROL_STOP);
end;
I am using the same setup as the OP - specifically, a TService descendant that simply starts a worker thread and then does nothing but process Windows messages. Unfortunately, you cannot call Controller from the worker thread because it is protected. Of course the simple way around it is to create a public method as I showed above. To use this from the worker thread you will need a reference to the TService object accessible from within the worker thread. I do this by passing my TService object into my worker thread in the thread's constructor.