服务OnExecute失败，生成的线程未执行

Question

首先在Delphi 7中启动我自己的服务。按照文档操作，使该服务生成一个自定义线程，发出哔哔声并记录日志。 只有它没有。 上一次尝试是将相同的蜂鸣声和日志代码放入OnExecute事件过程中，但是当我启动该服务时，我得到一个Windows对话框，提示它已启动，然后再次停止。

在这段代码中我应该忽略了一些明显的东西。

你能来看看吗？ 我还将接受指向简单，可运行，可下载的服务示例项目的链接……只是这样，我每隔10秒左右就会收到一个被称为的内容，然后从那里获取它。

Answer 1

接下来是一个简单的服务应用程序。

请注意，如果要使用ServiceApp.exe / install在Windows Vista和更高版本上安装服务，则必须确保您正在以管理员权限运行该应用程序。

另请注意，尽管使用了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

哔声将不起作用，请参阅此帖子 。

您的过程LG不够稳健，如果日志文件不存在，则LG可能会失败。 服务用户还必须有权访问该文件。 第一步，您可以使用您的用户帐户运行该服务以进行测试。

Answer 4

删除以下方法事件

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