Delphi XE中服务应用程序中的线程无法工作

Question

'MyThread'没有运行。我不知道问题是否发生在'DataTransferServiceStart'过程中。我猜测'DataTransferServiceStart'过程没有执行。IDE是Delphi XE。请帮助我，非常感谢。

线程单元：

unit Unit_MyThread;

interface

uses
  Classes, SysUtils;

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation


procedure TMyThread.Execute;
var
  log: TextFile;
  logPath: String;
  i: Integer;
begin
  logPath := 'd:\test.log';
  AssignFile(log, logPath);
  Append(log);
  i := 0;
  while not self.Terminated do
  begin
    Sleep(1);
    Writeln(log, IntToStr(i));
    if i=10 then
      Terminate;
    i := i + 1;
  end;
  CloseFile(log);
end;

end.

主服务单元：

unit Unit_main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls, DB, ADODB, Unit_MyThread;

type
  TDataTransferService = class(TService)
  DBSrc: TADOConnection;

  procedure DataTransferServiceStart(Sender: TService; var Started: Boolean);
  procedure DataTransferServiceContinue(Sender: TService; var Continued: Boolean);
  procedure DataTransferServicePause(Sender: TService; var Paused: Boolean);
  procedure DataTransferServiceStop(Sender: TService; var Stopped: Boolean);

  public
    function GetServiceController: TServiceController; override;
  end;
var
  DataTransferService: TDataTransferService;
  MyThread: TMyThread;
implementation

{$R *.DFM}

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

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

procedure TDataTransferService.DataTransferServiceStart(Sender: TService;
  var Started: Boolean);
begin
  MyThread := TMyThread.Create(False);
  Started := True;
end;

procedure TDataTransferService.DataTransferServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  MyThread.Start;
  Continued := True;
end;

procedure TDataTransferService.DataTransferServicePause(Sender: TService;
  var Paused: Boolean);
begin
  MyThread.Suspended := true;
  Paused := True;
end;

procedure TDataTransferService.DataTransferServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  MyThread.Terminate;
  Stopped := True;
end;

end.

- Rei Yau

---

它在哪里失败了？它是如何失败的？ - David Heffernan

'd:\test.log' 已经存在吗？ - Martin James

“does not work”的具体含义是什么？如果你想要帮助，你需要提供信息让我们可以尝试为你提供帮助。如果没有解释具体指什么，“does not work”就毫无意义。 - Ken White

@David，线程似乎没有运行。我找不到问题所在。 - Rei Yau

@KenWhite，“d:\test.log”存在。 - Rei Yau

Answer 1

您的服务很可能无法启动，因为您在服务中放置了一个 TADOConnection 组件。您不能在服务中这样做。由于 ADO 是 COM，您必须使用 CoInitialize（nil） 和 CoUninitialize 初始化每个线程，并仅在其中创建/使用数据库组件。请注意保留 HTML 标签。

uses
  ActiveX;

procedure TDataTransferService.DataTransferServiceStart(Sender: TService;
  var Started: Boolean);
begin
  CoInitialize(nil);
  DBSrc:= TADOConnection.Create(nil);
  //Initialize and Connect DBSrc
  MyThread := TMyThread.Create(False);
  Started := True;
end;

procedure TDataTransferService.DataTransferServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  MyThread.Terminate;
  //Disconnect DBSrc
  DBSrc.Free;
  CoUninitialize;
  Stopped := True;
end;

阅读这里：在线程中使用TADOConnection是否安全？

- Jerry Dodge

---

你的代码中有一个额外的 CoUnitialize。你在 DataTransferServiceStart 中调用了一次 CoInitialize，但在 DataTransferServiceStop 和 Execute 中的 finally 块中都调用了 CoUnitialize。 - Ken White

糟糕，我本来想删除那个第一个代码块的。当时发布时我很匆忙。 - Jerry Dodge

嗯..我注意到了 'DBSrc: TADOConnection'，但由于它似乎没有在任何地方被创建，所以忽略了它。 - Martin James

如果它在private部分之前（在这种情况下甚至没有私有部分），那么这意味着它被嵌入到服务中，这意味着当应用程序初始化时它会自动创建。 - Jerry Dodge

@ReiYau，你最好将所有代码都封装在线程内，包括数据库。你仍然需要关注CoInitialize(nil)，因为它在线程内；只是不要把它放在服务的主线程中。虽然在服务中直接放置代码是技术上可行的，但这总是被反对的做法——通常的做法是将所有代码封装在一个线程内，在服务启动时运行该线程。 - Jerry Dodge