Service OnExecute fails, spawned thread is not executed

Question

First go at starting my own service in Delphi 7. Followed the docs and made the service spawn a custom thread that beeps and logs. Only it doesn\'t. Last attempt was to put the

Answer 1

The beep will not work, see this post.

Your procedure LG is not verry robust it may fail if the log file doesn't exist. Also the service user must have the right to access the file. In a first step you can run the service with your user account for testing.

Answer 2

A bare bones service application follows.

Please note that if you want to install the service on Windows Vista and higher using ServiceApp.exe /install, you will have to ensure that you are running the app with administrator rights.

Also note that despite the fmShareDenyWrite the contents of the log file may not be viewable while the service is running. At least I couldn't open the file using Notepad++ until after I stopped the service. This may have to do with the fact that I had the service running under the system account (as opposed to my own user account).

One other remark: If you want to allow your service to be paused and continued, don't use suspend and resume. They are not thread safe and have been deprecated in D2010+. Using T(Simple)Event or something similar to control the main worker thread's execution. If you do not want to allow your service to be paused and continued, you can simply set AllowPause to False.

unit ServiceApp_fm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;

type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    FWorker: TThread;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

type
  TMainWorkThread = class(TThread)
  private
    {$IFDEF UNICODE}
    FLog: TStreamWriter;
    {$ELSE}
    FLog: TFileStream;
    {$ENDIF}
    FRepetition: Cardinal;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Execute; override;
  end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  FWorker := TMainWorkThread.Create;
  Started := True;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  // Thread should be freed as well as terminated so we don't have a memory
  // leak. Use FreeAndNil so we can also recognize when the thread isn't
  // available. (When the service has been stopped but the process hasn't ended
  // yet or may not even end when the service is restarted instead of "just" stopped.
  if FWorker <> nil then
  begin
    FWorker.Terminate;
    while WaitForSingleObject(FWorker.Handle, WaitHint-100) = WAIT_TIMEOUT do
      ReportStatus;
    FreeAndNil(FWorker);
  end;
  Stopped := True;
end;

{ TMainWorkThread }

constructor TMainWorkThread.Create;
var
  FileName: String;
begin
  inherited Create({CreateSuspended=}False);

  FileName := ExtractFilePath(ParamStr(0)) + '\WorkerLog.txt';
  {$IFDEF UNICODE}
  FLog := TStreamWriter.Create(FileName, False, TEncoding.Unicode);
  {$ELSE}
  FLog := TFileStream.Create(FileName, fmCreate);
  {$ENDIF}
end;

destructor TMainWorkThread.Destroy;
begin
  FLog.Free;
  inherited;
end;

procedure TMainWorkThread.Execute;
var
  Text: string;
begin
  inherited;

  while not Terminated do begin
    Inc(FRepetition);
    Text := Format('Logging repetition %d'#13#10, [FRepetition]);

    {$IFDEF UNICODE}
    FLog.Write(Text);
    {$ELSE}
    FLog.Write(Text[1], Length(Text));
    {$ENDIF}
    Sleep(1000);
  end;
end;

end.

Answer 3

Please have a look at http://www.delphi3000.com/articles/article_3379.asp for details on creating a service. I made that post years ago, but should still work.

Answer 4

Remove below method event

procedure TAviaABSwedenAMailer.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
        Beep;
        Sleep(500);
        LG('Amailer is running');
                ServiceThread.ProcessRequests(False);
  end;
end;