Question

首先在Delphi 7中开始我自己的服务。遵循文档并使服务产生一个发出哔哔声并记录的自定义线程。只有它没有。最后一次尝试是在OnExecute事件过程中输入相同的蜂鸣声和日志代码，但是当我启动服务时，我得到一个Windows对话框，说它已经启动然后再次停止。

我应该在this code中忽略一些明显的东西。

你能看一下吗？我也会接受简单，可工作，可下载的服务示例项目的链接...这样我每隔10秒左右就会调用一次，我会从那里开始。

Answer 1

随后是一个简单的骨骼服务应用程序。

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

另请注意，尽管存在fmShareDenyWrite，但在服务运行时可能无法查看日志文件的内容。在我停止服务之前，至少我无法使用Notepad ++打开文件。这可能与我在系统帐户下运行服务（而不是我自己的用户帐户）这一事实有关。

另一个评论：如果您希望暂停和继续服务，请不要使用暂停和恢复。它们不是线程安全的，在D2010 +中已被弃用。使用T（简单）事件或类似的东西来控制主工作线程的执行。如果您不希望暂停和继续服务，则可以将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

哔哔声不起作用，请参阅此post。

如果日志文件不存在，您的过程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;

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

4 个答案: