Delphi创建服务程序

最新推荐文章于 2024-05-27 16:19:43 发布

wsgqp

最新推荐文章于 2024-05-27 16:19:43 发布

阅读量7.5k

点赞数 2

分类专栏： Delphi 文章标签： delphi Service 服务程序 Windows服务 windows

本文链接：https://blog.csdn.net/wsgqp/article/details/51901146

版权

Delphi 专栏收录该内容

1 篇文章 1 订阅

订阅专栏

Windows 2000/XP和2003等支持一种叫做”服务程序”的东西.程序作为服务启动有以下几个好处:

不用登陆进系统即可运行.
具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.

如何创建Service

下面就介绍一下如何用Delphi7创建一个Service程序：
运行Delphi7,选择菜单File–>New–>Other—>Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:

DisplayName:服务的显示名称
Name:服务名称.

如下图所示，Service的属性Name和DisplayName分别对应服务的服务名称和显示名称
这里写图片描述

Service事件：

创建完代码后我们就可以在Service服务的各个事件里面编写相关代码实现我们的功能了，一般在代码中我们都会实现以下几个事件方法，根据字面意思应该就知道这些方法是做什么用的了，这里就不做过多解释了
这里写图片描述

Service调试

Service程序不容易调试，一般我们可以通过写日志的方式调试，这里我介绍另外一种调试方式，通过编译指令把Service转换成普通程序，然后再进行调试，方法如下：

1.新建一个窗体MainFrm，将需要实现的功能写在这个单元

2.处理项目文件的单元头，添加一个编译指令DEBUG

program ProManage;

uses
  {$IFDEF DEBUG}
  Forms,
  {$ELSE}
  SvcMgr,
  {$ENDIF}
  frmProMain in 'frmProMain.pas' {MainFrm},
  uService in 'uService.pas' {PMTOH3sv: TService};

{$R *.res}

begin
  Application.Initialize;
  Application.Title := 'PMTOH3';
  {$IFDEF DEBUG}
  Application.CreateForm(TMainFrm, MainFrm);
  {$ELSE}
  Application.CreateForm(TPMTOH3sv, PMTOH3sv);
  {$ENDIF}
  Application.Run;
end.

3.把代码需要实现的功能全部在主窗体单元中实现，然后在ServiceStart中调用该主窗体，如下

procedure TPMTOH3sv.ServiceShutdown(Sender: TService);
begin
  MainFrm.Free;
  CoUninitialize;
  Status := csStopped;
  ReportStatus(); 
end;

procedure TPMTOH3sv.ServiceStart(Sender: TService; var Started: Boolean);
begin
  CoInitialize(nil);
  Started := True;
  Svcmgr.Application.CreateForm(TMainFrm, MainFrm);
  MainFrm.Hide;
end;

总结：这样当我们调试的时候设置Debug为True就可以直接调试，当调试完毕后我们把Debug设为False就可以编译成一个服务程序了

下面我给出一个完整的例子

工程文件：Project1.dpr

program ProManage;

uses
  {$IFDEF DEBUG}
  Forms,
  {$ELSE}
  SvcMgr,
  {$ENDIF}
  frmProMain in 'frmProMain.pas' {MainFrm},
  uService in 'uService.pas' {PMTOH3sv: TService};

{$R *.res}

begin
  Application.Initialize;
  Application.Title := 'PMTOH3';
  {$IFDEF DEBUG}
  Application.CreateForm(TMainFrm, MainFrm);
  {$ELSE}
  Application.CreateForm(TPMTOH3sv, PMTOH3sv);
  {$ENDIF}
  Application.Run;
end.

服务程序单元：uService.pas

unit uService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  frmProMain, ActiveX;

type
  TPMTOH3sv = class(TService)
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceExecute(Sender: TService);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceShutdown(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  PMTOH3sv: TPMTOH3sv;

implementation

{$R *.DFM}

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

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

procedure TPMTOH3sv.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  while not Terminated do
  begin
    Sleep(10);
    ServiceThread.ProcessRequests(False);
  end;
end;

procedure TPMTOH3sv.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    Sleep(10);
    ServiceThread.ProcessRequests(False);
  end;
end;

procedure TPMTOH3sv.ServicePause(Sender: TService; var Paused: Boolean);
begin
  Paused := True;
end;

procedure TPMTOH3sv.ServiceShutdown(Sender: TService);
begin
  MainFrm.Free;
  CoUninitialize;
  Status := csStopped;
  ReportStatus(); 
end;

procedure TPMTOH3sv.ServiceStart(Sender: TService; var Started: Boolean);
begin
  CoInitialize(nil);
  Started := True;
  Svcmgr.Application.CreateForm(TMainFrm, MainFrm);
  MainFrm.Hide;
end;

procedure TPMTOH3sv.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Stopped := True;
  MainFrm.Free;
end;

end.

安装和卸载服务

没什么好说的，直接看代码

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,SvcMgr,winsvc;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Button6: TButton;
    procedure Button6Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public

    { Public declarations }
  end;
  function InstallService(ServiceName, DisplayName, FileName: string): boolean;
  function UninstallService(ServiceName: string):boolean;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function InstallService(ServiceName, DisplayName, FileName: string): boolean;
var
  SCManager,Service: THandle;
  Args: pchar;
begin
  Result := False;
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then Exit;
  try
   Service := CreateService(SCManager,  //句柄
                    PChar(ServiceName), //服务名称
                    PChar(DisplayName), //显示服务名
                    SERVICE_ALL_ACCESS, //服务访问类型
                    SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, //服务类型  or SERVICE_WIN32_OWN_PROCESS,//
                    SERVICE_AUTO_START, //自动启动服务
                    SERVICE_ERROR_IGNORE, //忽略错误
                    PChar(FileName),  //启动的文件名
                    nil,  //name of load ordering group (载入组名) &#39;LocalSystem&#39;
                    nil,  //标签标识符
                    nil,  //相关性数组名
                    nil,  //帐户(当前)
                    nil); //密码(当前)

   Args := nil;
   if Service = 0 then exit;
   if StartService(Service, 0, Args) then
     Form1.memo1.Lines.Add(DisplayName+' 服务已经启动')
   else
     Form1.memo1.Lines.Add(DisplayName+' 服务启动失败！');
   CloseServiceHandle(Service);
   CloseServiceHandle(SCManager);
  except on E: Exception do
    begin
      CloseServiceHandle(SCManager);
      Form1.Memo1.Lines.Add('失败原因是：' + E.Message);
    end;
  end;
  Result := True;
end;

function UninstallService(ServiceName: string):boolean;
var
   SCManager,Service: THandle;
   ServiceStatus: SERVICE_STATUS;
   ss: LongBool;
begin
  Result:=false;
   SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);//获得SC管理器句柄
   if SCManager = 0 then Exit;
   try
     Service := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);

     //以最高权限打开指定服务名的服务,并返回句柄
     ss := ControlService(Service, SERVICE_CONTROL_STOP, ServiceStatus);
     Form1.Memo1.Lines.Add('停止服务结果：' + BoolToStr(ss));

     //向服务器发送控制命令,停止工作, ServiceStatus 保存服务的状态
     ss := DeleteService(Service);
     Form1.Memo1.Lines.Add('卸载服务结果：' + BoolToStr(ss));
     //从SC ManGer 中删除服务
     CloseServiceHandle(Service);
     result:=true;
     //关闭句柄,释放资源
   finally
     CloseServiceHandle(SCManager);
   end;
end;


procedure TForm1.Button6Click(Sender: TObject);
begin
  if UninstallService('PMTOH3sv_ZCWY') then
    memo1.Lines.Add('PMTOH3存储过程扫描执行服务卸载成功')
  else
    memo1.Lines.Add('PMTOH3存储过程扫描执行服务卸载失败');
  Memo1.Lines.Add('如果卸载服务时有返回-1，则多试几次，或强制结束进程再卸载。');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetCurrentDir(ExtractFilePath(Forms.Application.exename));
  SetCurrentDir(GetCurrentDir);
  if OpenDialog1.Execute then
  begin
    if InstallService('PMTOH3sv_ZCWY','PMTOH3存储过程扫描执行服务',OpenDialog1.FileName) then
      memo1.Lines.Add('PMTOH3存储过程扫描执行服务安装成功')
    else
      memo1.Lines.Add('PMTOH3存储过程扫描执行服务安装失败');
  end;
end;

end.

这里重点说明一下：InstallService方法里的参数ServiceName必须为上面创建服务时的服务名一致，否则将出现如下情况：安装服务成功后，没有启动，停止，暂停服务的功能，DisplayName无需一致，这里的DisplayName会覆盖服务程序默认的DisplayName

wsgqp

关注

2
点赞
踩
14

收藏

觉得还不错? 一键收藏
0
评论
Delphi创建服务程序

Windows 2000/XP和2003等支持一种叫做”服务程序”的东西.程序作为服务启动有以下几个好处:不用登陆进系统即可运行.具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.如何创建Service下面就介绍一下如何用Delphi7创建一个Service程序：运行Delphi7,选择菜单File–>New–>Other—>Service Application.将生成一个服务
复制链接

扫一扫