multithreading - 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.

Answer 1

您的服务很可能无法启动，因为您的服务中放入了 TADOConnection 组件。您不能在服务中执行此操作。由于 ADO 是 COM，因此您必须使用 CoInitialize(nil) 和 CoUninitialize 初始化每个线程，并且仅在其中创建/使用数据库组件。

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;

阅读此处:Ok to use TADOConnection in threads