Сбой службы OnExecute, порожденный поток не выполняется

Question

Сначала запустите мой собственный сервис в Delphi 7. Следуйте документации и сделайте сервис порождающим пользовательский поток, который подает звуковой сигнал и ведет журнал. Только это не так. Последней попыткой было ввести тот же звуковой сигнал и код журнала в процедуру события OnExecute, но когда я запускаю службу, я получаю диалоговое окно Windows, сообщающее, что оно было запущено, а затем остановлено снова.

Должно быть что-то очевидное, что я пропустил в этом коде .

Не могли бы вы взглянуть? Я также приму ссылки на простые, работающие, загружаемые примеры проектов служб ... просто чтобы я получал то, что вызывается каждые 10 секунд или около того, и я возьму его оттуда.

Answer 1

Далее следует приложение для обслуживания голых костей.

Обратите внимание, что если вы хотите установить службу в Windows Vista и выше с помощью ServiceApp.exe / install, вам необходимо убедиться, что вы запускаете приложение с правами администратора.

Также обратите внимание, что, несмотря на fmShareDenyWrite, содержимое файла журнала может быть недоступно для просмотра во время работы службы. По крайней мере, я не мог открыть файл с помощью Notepad ++, пока я не остановил службу. Это может быть связано с тем, что у меня служба работала под системной учетной записью (в отличие от моей собственной учетной записи пользователя).

Еще одно замечание: Если вы хотите, чтобы ваш сервис был приостановлен и продолжен, не используйте приостановку и возобновление. Они не являются поточно-ориентированными и устарели в D2010 +. Использование T (Simple) Event или чего-то подобного для управления выполнением основного рабочего потока. Если вы не хотите, чтобы ваша служба была приостановлена ​​и продолжена, вы можете просто установить AllowPause в 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 2

Пожалуйста, посмотрите на http://www.delphi3000.com/articles/article_3379.asp для получения подробной информации о создании службы. Я сделал этот пост несколько лет назад, но все еще должен работать.

Answer 3

Удалить ниже событие метода

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

Answer 4

Звуковой сигнал не будет работать, см. сообщение .

Ваша процедура LG не очень надежна и может завершиться ошибкой, если файл журнала не существует.Также пользователь сервиса должен иметь право доступа к файлу.На первом этапе вы можете запустить службу с учетной записью пользователя для тестирования.