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

最新推荐文章于 2015-11-05 16:53:58 发布

原创最新推荐文章于 2015-11-05 16:53:58 发布 · 2.9k 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#delphi #attributes #security #descriptor #service #windows

Delphi 编写系统服务总结专栏收录该内容

7 篇文章

订阅专栏

本文介绍了一种两栖系统服务的开发方法，该方法允许同一程序既可以作为桌面应用程序运行，也可以作为系统服务运行。通过使用特定的代码结构和条件判断，确保了程序能够在不同的环境中正确启动。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

采用下面的方法，可以实现一个两栖系统服务（既系统服务和桌面程序的两种模式）
工程代码：
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方法。