Question

我正在努力使用Delphi中的服务应用程序但到目前为止没有取得重大成功。我尝试重新创建this project，但它似乎无法正常工作。文件已创建，但日期和时间不会每10秒添加到文件中。我也没有看到从我的ShowMessage弹出的消息。我成功安装并启动了服务应用程序。

这是我的代码：

unit TMS;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
  Vcl.ExtCtrls;

type
  TWorkflow = class(TService)
    Timer1: TTimer;
    procedure ServiceExecute(Sender: TService);
    procedure Timer1Timer(Sender: TObject);
    procedure ServiceBeforeInstall(Sender: TService);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Workflow: TWorkflow;

implementation

{$R *.dfm}

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

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

procedure TWorkflow.ServiceBeforeInstall(Sender: TService);
begin
  Interactive := True;
end;

procedure TWorkflow.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    ServiceThread.ProcessRequests(True);
  end;
end;

procedure TWorkflow.Timer1Timer(Sender: TObject);
const
  FileName = 'D:\Projekti\EMBRACADERO\TMSWorkflow\Win32\Debug\Log.txt';
var
  F : TextFile;
begin
  AssignFile(F, FileName);
  if FileExists(FileName) then
    Append(F)
  else
    Rewrite(F);
  Writeln(F, DateTimeToStr(Now), ' ', DiskFree(0));
  ShowMessage(DateTimeToStr(Now));
  CloseFile(F);
end;

end.

有人可以给我一个带线程的服务应用程序的例子，或者包含可视组件的服务吗？

UPDATE1：

它使用以下代码每3秒在数据库中插入一些数据。

private
    thread : TThread;  

procedure TWorkflow.InsertInDatabase;
begin
  FDTransaction1.StartTransaction;
  try
    FDQuery1.Execute;
    FDTransaction1.Commit;
  except
    FDTransaction1.Rollback;
  end;
end;

procedure TWorkflow.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    ServiceThread.ProcessRequests(False);
    InsertInDatabase();
    thread.sleep(3000);
  end;
end;

procedure TWorkflow.ServiceStart(Sender: TService; var Started: Boolean);
begin
  thread := TThread.Create;
end;

procedure TWorkflow.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  FreeAndNil(thread);
end;

Answer 1

您展示的TTimer代码很好（虽然您的OnExecute事件是冗余的，但应该完全删除），除了对ShowMessage()的调用，根本不能在服务中使用（TService.Interactive属性对Windows Vista +没有影响）。如果必须显示服务的弹出消息框（您应该努力不这样做），则必须使用指定了MessageBox()标志的Win32 API MB_SERVICE_NOTIFICATION，或使用WTSSendMessage()代替。否则，您必须将任何UI委派给服务根据需要生成和/或与之通信的单独非服务进程。

另一方面，您的TThread代码完全错误。它应该更像是这样：

unit TMS;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.SvcMgr;

type
  TWorkflowThread = class(TThread)
  protected
    procedure Execute; override;
  end;

  TWorkflow = class(TService)
    FDTransaction1: TFDTransaction;
    FDQuery1: TFDQuery;
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceShutdown(Sender: TService);
  private
    { Private declarations }
    thread: TWorkflowThread;
    procedure InsertInFile;
    procedure InsertInDatabase;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Workflow: TWorkflow;

implementation

{$R *.dfm}

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

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

procedure TWorkflow.InsertInFile;
const
  FileName = 'D:\Projekti\EMBRACADERO\TMSWorkflow\Win32\Debug\Log.txt';
var
  F : TextFile;
begin
  try
    AssignFile(F, FileName);
    try
      if FileExists(FileName) then
        Append(F)
      else
        Rewrite(F);
      Writeln(F, DateTimeToStr(Now), ' ', DiskFree(0));
      //ShowMessage(DateTimeToStr(Now));
    finallly
      CloseFile(F);
    end;
  except
  end;
end;

procedure TWorkflow.InsertInDatabase;
begin
  try
    FDTransaction1.StartTransaction;
    try
      FDQuery1.Execute;
      FDTransaction1.Commit;
    except
      FDTransaction1.Rollback;
    end;
  except
  end;
end;

procedure TWorkflow.ServiceStart(Sender: TService; var Started: Boolean);
begin
  thread := TWorkflowThread.Create(False);
  Started := True;
end;

procedure TWorkflow.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  ServiceShutdown(Sender);
  Stopped := True;
end;

procedure TWorkflow.ServiceShutdown(Sender: TService);
begin
  if Assigned(thread) then
  begin
    thread.Terminate;
    while WaitForSingleObject(thread.Handle, WaitHint-100) = WAIT_TIMEOUT do
      ReportStatus;
    FreeAndNil(thread);
  end;
end;

procedure TWorkflowThread.Execute;
begin
  while not Terminated do
  begin
    Workflow.InsertInFile;
    Workflow.InsertInDatabase;
    TThread.Sleep(3000);
  end;
end;

end.

Answer 2

您的计时器代码将无法执行，因为计时器依赖于TService未提供的窗口句柄和消息泵。此外，TTimer不是线程安全的，因为在使用VCL的AllocateHwnd()函数时，该函数不是线程安全的，不应在主线程的上下文之外使用。通常，在编写服务应用程序时，您将生成一个工作线程来执行主逻辑。

如果您需要线程安全计时器，我建议您使用其他计时器机制，例如WaitForSingleObject()

在服务上，服务不应包含任何可视控件，因为它们根本不应与桌面交互。

Answer 3

有人可以给我一个带线程的服务应用程序示例。

如果您的代码在一个线程中完成所有工作，那么您几乎已经完成了。

只需在服务启动事件中启动您的线程即可。要进行调试，请在小型（控制台）程序中运行该线程。

让主线程休眠一段时间而不是计时器。

Delphi中的服务应用程序

3 个答案: