Delphi Windows服务设计

Dar*_*n - 20 windows delphi service tcp

Delphi Windows服务设计

我从未创建过Windows服务,但一直在阅读我发现的所有内容.我遇到的所有文章或示例都是非常基础的,并且范围有限.没有看到任何超出此范围的内容或针对特定方案的内容.所以,我有可能找到的所有理论,现在我已经准备好深入研究这个项目了.我喜欢布置我的想法,并对人们的想法得到一些反馈.我将从应用程序中描述我需​​要的内容以及我打算如何构建它.我很感激任何有建立Windows服务经验的人的评论以及他们愿意分享的任何建议.

[SCENARIO]现在我有一个应用程序(我称之为UPDATEAPPLICATION),它为我们所有其他应用程序提供更新.为了运行我们的任何应用程序,首先必须运行此UPDATEAPPLICATION程序并向其传递所需应用程序的参数.UPDATEAPPLICATION调用WebService,该WebService返回关于所需应用程序是否有任何更新的XML信息.

如果有更新,UPDATEAPPLICATION将以EXE或ZIP格式下载更新,并替换相应的文件以更新目标应用程序.然后UPDATEAPPLICATION执行ShellExecute以启动所需的应用程序,然后关闭UPDATEAPPLICATION.

这是一个相当基本的过程,多年来一直运作良好.UPDATEAPPLICATION程序是一个Delphi应用程序,我们的其他应用程序是混合的:Delphi,VB6,MS Access,.NET.

[问题]随着迁移到Vista和Windows 7,安全性发生了巨大变化.由于UPDATEAPPLICATION的性质,UAC将不允许应用程序在没有Admin访问或UAC完全关闭的情况下运行.我们正在将许多应用程序升级到.NET,在此过程中,我希望应用程序以及UPDATEAPPLICATION符合UAC标准.根据我的研究,唯一的方法是将UPDATEAPPLICATION创建为Windows服务.因此,基本上,我需要将UPDATEAPPLICATION的功能复制到Windows服务体系结构中.

[我的设计]我正在使用DelphiXE2.我的设计将由3个部分组成,形成一个解决方案:Windows服务,与Windows服务交互的小托盘应用程序,以及将重新设计的应用程序,它们将向Windows服务发送消息.

  1. 我的Windows服务(我称之为UPDATESERVICE)将作为Windows服务运行并创建一个TCP服务器来监听请求.
  2. 托盘应用程序(我将称之为TRAYAPP)将使用TCP客户端来配置/管理UPDATESERVICE.
  3. 我的USERAPPLICATION,在启动时,会向UPDATESERVICE发送一条TCP消息,表示"此应用程序"已启动.

[UPDATESERVICE]将收听消息.如果它收到USERAPPLICATION已启动的消息,它将调用Web服务以查看是否有更新.如果有,将通知用户关闭应用程序并允许UPDATESERVICE更新应用程序.UPDATESERVICE将下载相应的文件并更新应用程序.

现在我已经解释了我正在尝试做的基础知识,我可以问我需要回答的具体问题.这些都与我应该如何构建我的Windows服务有关.我还计划使用OmniThread进行线程管理.

当我的服务启动时,我需要创建TCP服务器.

  1. 是否应该在自己的线程上创建TCP服务?
  2. 如果TCP服务是它自己的线程,我该如何保持线程活着?否则,我可以启动TCP服务但是我不确定在TCP服务单元中使用什么代码来保持线程运行?
  3. 什么Windows服务事件应该创建TCP服务?OnExecute?的OnStart?在OnCreate?毕竟我读过它不清楚应该使用什么事件.
  4. 当TCP服务收到要执行某些操作的消息时,是否应该在TCP服务线程中执行工作,还是从主UPDATESERVICE中生成新线程?例如:
    • 如果TCP服务获取使用HTTP检查更新的消息,则TCP服务线程会生成一个新线程来执行此操作
    • 或者,TCP服务线程是否应该向UPDATESERVICE发送消息以生成新线程来执行此操作
    • 它甚至重要吗?
  5. 是否可以在Delphi Code中启动/停止/注册/取消注册Windows服务?

这是我的全部问题.对此可能没有正确/错误的答案,而只是基于经验的偏好.如果你用Delphi构建服务,你可能会有一些我认为有用的输入.如果你有一个更健壮的项目,那么基本的"启动服务和睡眠"并愿意分享它 - 即使我没有运行或只是伪造代码 - 我相信这将是非常宝贵的.感谢您阅读我冗长的问题.如果您能想出更好的方法,请分享您的想法.我将补充说,我们的一些应用程序可以由公众下载和运行,因此我无法完全控制预期的环境.任何建议/意见/帮助将不胜感激.

who*_*ddy 25

快速回答:

1&3)是的.根据经验,不要实现OnExecute服务事件.从OnStart服务事件中生成您自己的线程.收到OnStop服务事件时,可以终止该线程.

2)你保持你的线程像这样(执行方法):

while not Terminated do
begin
  // do something
end;
Run Code Online (Sandbox Code Playgroud)

4)通常每个客户端连接都将存在于它自己的线程上.(即TCP服务器为每个客户端生成一个新线程).使用像Indy或ICS这样众所周知的堆栈.关于HTTP更新,您可以在生成的客户端连接线程中执行此操作.

5)是的,请注意您需要提升权限才能执行此操作.

我在职业生涯中提供了不少服务,到目前为止,我总是使用相同的骨架作为服务应用程序:

unit u_svc_main;

interface

uses
  // Own units
  u_globals, u_eventlog, u_MyThread, 
  // Third party units
  // Delphi units
  Windows, Messages, Registry, SysUtils, Classes, SvcMgr;

type
  TMyService = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceAfterUninstall(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
    procedure ServiceShutdown(Sender: TService);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    { Private declarations }
    MyThread : TMyThread;
  public
    { Public declarations }
    function GetServiceController: TServiceController; override;
  end;

var MyService : TMyService;

implementation

{$R *.DFM}

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

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

procedure TMyService.ServiceCreate(Sender: TObject);
begin
  DisplayName := 'myservice';
end;

procedure TMyService.ServiceAfterInstall(Sender: TService);
var
  Reg        : TRegistry;
  ImagePath  : string;
begin
  // create needed registry entries after service installation
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    // set service description
    if Reg.OpenKey(STR_REGKEY_SVC,False) then
    begin
      ImagePath := Reg.ReadString(STR_REGVAL_IMAGEPATH);
      Reg.WriteString(STR_REGVAL_DESCRIPTION, STR_INFO_SVC_DESC);
      Reg.CloseKey;
    end;
    // set message resource for eventlog
    if Reg.OpenKey(STR_REGKEY_EVENTMSG, True) then
    begin
      Reg.WriteString(STR_REGVAL_EVENTMESSAGEFILE, ImagePath);
      Reg.WriteInteger(STR_REGVAL_TYPESSUPPORTED, 7);
      Reg.CloseKey;
    end;
    // set installdir
    if ImagePath <> '' then
      if Reg.OpenKey(STR_REGKEY_FULL,True) then
      begin
        Reg.WriteString(STR_REGVAL_INSTALLDIR, ExtractFilePath(ImagePath));
        Reg.CloseKey;
      end;
  finally
    FreeAndNil(Reg);
  end;
end;

procedure TMyService.ServiceAfterUninstall(Sender: TService);
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    // delete self created registry keys
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.DeleteKey(STR_REGKEY_EVENTMSG);
  finally
    FreeAndNil(Reg);
  end;
end;

procedure TMyService.ServiceShutdown(Sender: TService);
var
  Stopped : boolean;
begin
  // is called when windows shuts down
  ServiceStop(Self, Stopped);
end;

procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Started := False;
  try
    MyThread := TMyThread.Create;
    MyThread.Resume;
    NTEventLog.Add(Eventlog_Success, STR_INFO_SVC_STARTED);
    Started := True;
  except
    on E : Exception do
    begin
      // add event in eventlog with reason why the service couldn't start
      NTEventLog.Add(Eventlog_Error_Type, Format(STR_INFO_SVC_STARTFAIL, [E.Message]));
    end;
  end;
end;

procedure TMyService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  try
    Stopped := True; // always stop service, even if we had exceptions, this is to prevent "stuck" service (must reboot then)
    MyThread.Terminate;
    // give MyThread 60 seconds to terminate
    if WaitForSingleObject(MyThread.ThreadEvent, 60000) = WAIT_OBJECT_0 then
    begin
      FreeAndNil(MyThread);
      NTEventLog.Add(Eventlog_Success,STR_INFO_SVC_STOPPED);
    end;
  except
    on E : Exception do
    begin
      // add event in eventlog with reason why the service couldn't stop
      NTEventLog.Add(Eventlog_Error_Type, Format(STR_INFO_SVC_STOPFAIL, [E.Message]));
    end;
  end;
end;

end.
Run Code Online (Sandbox Code Playgroud)

  • 甜.感谢您抽出宝贵时间作出回应.这是我正在寻找的实用输入类型.你的骨架代码充实了起点,这比我到目前为止发现的很多东西都要好.你的其他答案我们也是我所期待的.很高兴听到来自那条路的人.再次感谢. (2认同)