Delphi编写系统服务三：编写两栖系统服务

Delphi编写系统服务三：编写两栖系统服务 收藏
 采用下面的方法，可以实现一个两栖系统服务（既系统服务和桌面程序的两种模式）
工程代码：
program FleetReportSvr;

uses
  SvcMgr,
  Forms,
  SysUtils,
  Windows,
  SvrMain in 'SvrMain.pas' {FleetReportService: TService},
  AppMain in 'AppMain.pas' {FmFleetReport}；

{$R *.RES}

const
  CSMutexName = 'Global/Services_Application_Mutex';
var
  OneInstanceMutex: THandle;
  SecMem: SECURITY_ATTRIBUTES;
  aSD: SECURITY_DESCRIPTOR;
begin
  InitializeSecurityDescriptor(@aSD, SECURITY_DESCRIPTOR_REVISION);
  SetSecurityDescriptorDacl(@aSD, True, nil, False);
  SecMem.nLength := SizeOf(SECURITY_ATTRIBUTES);
  SecMem.lpSecurityDescriptor := @aSD;
  SecMem.bInheritHandle := False;
  OneInstanceMutex := CreateMutex(@SecMem, False, CSMutexName);
  if (GetLastError = ERROR_ALREADY_EXISTS)then
  begin
    DlgError('Error, Program or service already running!');
    Exit;
  end;
  if FindCmdLineSwitch('svc', True) or
    FindCmdLineSwitch('install', True) or
    FindCmdLineSwitch('uninstall', True) then
  begin
    SvcMgr.Application.Initialize;
    SvcMgr.Application.CreateForm(TSvSvrMain, SvSvrMain);
    SvcMgr.Application.Run;
  end
  else
  begin
    Forms.Application.Initialize;
    Forms.Application.CreateForm(TFmFmMain, FmMain);
    Forms.Application.Run;
  end;
end.
然后在SvrMain注册服务：
unit SvrMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, MsgCenter;

type
  TSvSvrMain = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceBeforeInstall(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  SvSvrMain: TSvSvrMain;

implementation

const
  CSRegServiceURL = 'SYSTEM/CurrentControlSet/Services/';
  CSRegDescription = 'Description';
  CSRegImagePath = 'ImagePath';
  CSServiceDescription = 'Services Sample.';

{$R *.DFM}

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

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

procedure TSvSvrMain.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
  Started := dmPublic.Start;
end;

procedure TSvSvrMain.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  Stopped := dmPublic.Stop;
end;

procedure TSvSvrMain.ServiceBeforeInstall(Sender: TService);
begin
  RegValueDelete(HKEY_LOCAL_MACHINE, CSRegServiceURL + Name, CSRegDescription);
end;

procedure TSvSvrMain.ServiceAfterInstall(Sender: TService);
begin
  RegWriteString(HKEY_LOCAL_MACHINE, CSRegServiceURL + Name, CSRegDescription,
    CSServiceDescription);
  RegWriteString(HKEY_LOCAL_MACHINE, CSRegServiceURL + Name, CSRegImagePath,
    ParamStr(0) + ' -svc');
end;

end.
这样，双击程序，则以普通程序方式运行，若用服务管理器来运行，则作为服务运行。
例如公共模块：
dmPublic，提供Start,Stop方法。

在主窗体中，调用dmPublic.Start，dmPublic.Stop方法。
同样在Service中，调用dmPublic.Start，dmPublic.Stop方法。

 

本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/Bear_hx/archive/2008/11/28/3403906.aspx