轉 帶有界面的服務程序

    技术2025-03-21  21

    本来是没有打算把软件写成服务形式的。起因是因为,我原来写的一个TCP通讯程序的客户端,客户在使用时,因为经常断电,所以服务器有时候会重启,因为原来的程序不是服务形式的,在没有登陆windows界面的情况下,不能够自动运行。因此,才决定把现有的程序改为服务形式。

          一、服务程序的创建

              delphi编写服务程序非常简单,点击菜单 File->New->Other->New属性页->Service Application,系统自动会创建基本的代码。这里需要说明的是,在“New属性页”中还有一个Service,这个Service和Service Application还是有区别的,应该说Service Application的范围大,它可以包含几个Service。

            一个Service Application可以创建几个Service,service继承自TService,界面表现和TDataModel类似,做过数据库的朋友肯定都不陌生,区别是TDataModel是用来放数据库连接及操作组件的容器,而TService则是可以存放很多没有界面的组件,如indy的IDtcpclient等。

          二、重要属性及事件说明

         属性:DisplayName 显示名称

                     Name   名称,当你用命令提示符来启动、停止服务时,就需要用到

                     Interactive 与界面交互的选项

       事件:OnCreate:类似于Tform的OnCreate

                   OnDestroy:类似于Tform的OnDestroy

                   OnExecute:非常重要,一般写成下面

    while not Terminated do

    begin

       Sleep(10);

       ServiceThread.ProcessRequests(False);

    end;

                OnPause:服务暂停

                OnShutdown:不太清楚

                OnStart:服务启动,重要

                OnStop:服务停止,重要

    三、服务的依赖关系

          因为我的服务是要连接数据库的,所以必须要等sql server的服务起来之后,我才能起来,这样才能连接数据库,因此这里面有个依赖关系的问题。可以在属性Dependencies中增加一项,选择MSSQLSERVER。

    四、服务与界面的通讯

         服务也是可以创建form的,只是只是这个窗口,在服务启动时显示,服务停止后就关闭了。而我想做一个就象sql server 2000的服务管理器哪样的界面,不论服务启动是否,都可以显示,而且也可以在界面上直接控制服务。所以我就又建了一个应用,而这个应用和原来服务的通讯用自定义消息来传递。比如,有人通过控制面板停止服务了,服务必须通知界面上的状态。

     

    Delphi获取Windows系统服务的状态

    function ServiceGetStatus(sMachine, sService: string ): DWord;

    var

    schm, schs: SC_Handle;

    ss: TServiceStatus;

    dwStat : DWord;

    begin

    dwStat := 0;

    schm := OpenSCManager(PChar(sMachine), Nil, SC_MANAGER_CONNECT);

    if (schm > 0) then

    begin

        schs := OpenService(schm, PChar(sService), SERVICE_QUERY_STATUS);

        if(schs > 0) then

        begin

          if(QueryServiceStatus(schs, ss))then dwStat := ss.dwCurrentState;

          CloseServiceHandle(schs);

        end;

        CloseServiceHandle(schm);

    end;

    Result := dwStat;

    end;

    {判断某服务是否安装,未安装返回true,已安装返回false}

    function ServiceUninstalled(sMachine, sService : string ) : boolean;

    begin

    Result := 0 = ServiceGetStatus(sMachine, sService);

    end;

    {判断某服务是否启动,启动返回true,未启动返回false}

    function ServiceRunning(sMachine, sService : string ) : boolean;

    begin

    Result := SERVICE_RUNNING = ServiceGetStatus(sMachine, sService );

    end;

    {判断某服务是否停止,停止返回true,未停止返回false}

    function ServiceStopped(sMachine, sService : string ) : boolean;

    begin

    Result := SERVICE_STOPPED = ServiceGetStatus(sMachine, sService );

    end;

     

    Delphi 如何停止、启动windows系统服务

    //下面是 写了一个启动服务的函数 StartService,用来启动服务。。。

    function StartService(AServName: string): Boolean; //use WinSvc

    var

    SCManager, hService: SC_HANDLE;

    lpServiceArgVectors: PChar;

    begin

    SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

    Result := SCManager <> 0;

    if Result then

    try

    hService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS);

    Result := hService <> 0;

    if (hService = 0) and (GetLastError = ERROR_SERVICE_DOES_NOT_EXIST) then

    Exception.Create('The specified service does not exist');

    if hService <> 0 then

    try

    lpServiceArgVectors := nil;

    Result := WinSvc.StartService(hService, 0, PChar(lpServiceArgVectors));

    if not Result and (GetLastError = ERROR_SERVICE_ALREADY_RUNNING) then

    Result := True;

    finally

    CloseServiceHandle(hService);

    end;

    finally

    CloseServiceHandle(SCManager);

    end;

    end;

    function StartService(AServName: string): Boolean; //use WinSvc<br/>var<br/>SCManager, hService: SC_HANDLE;<br/>lpServiceArgVectors: PChar;<br/>begin<br/>SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);<br/>Result := SCManager <> 0;<br/>if Result then<br/>try<br/>hService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS);<br/>Result := hService <> 0;<br/>if (hService = 0) and (GetLastError = ERROR_SERVICE_DOES_NOT_EXIST) then<br/>Exception.Create('The specified service does not exist');<br/>if hService <> 0 then<br/>try<br/>lpServiceArgVectors := nil;<br/>Result := WinSvc.StartService(hService, 0, PChar(lpServiceArgVectors));<br/>if not Result and (GetLastError = ERROR_SERVICE_ALREADY_RUNNING) then<br/>Result := True;<br/>finally<br/>CloseServiceHandle(hService);<br/>end;<br/>finally<br/>CloseServiceHandle(SCManager);<br/>end;<br/>end;<br/>

    下面是停止服务的代码 StopService

    function StopService(AServName: string): Boolean;

    var

    SCManager, hService: SC_HANDLE;

    SvcStatus: TServiceStatus;

    begin

    SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

    Result := SCManager <> 0;

    if Result then

    try

    hService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS);

    Result := hService <> 0;

    if Result then

    try //停止并卸载服务;

    Result := ControlService(hService, SERVICE_CONTROL_STOP, SvcStatus);

    //删除服务,这一句可以不要;

    // DeleteService(hService);

    finally

    CloseServiceHandle(hService);

    end;

    finally

    CloseServiceHandle(SCManager);

    end;

    end;

    使用delphi新建服务,停止系统服务

    2009-12-09 15:46本文主要讲解了如何使用delphi新建服务,停止系统服务,以及获取服务状态和新建系统服务器的方法,以下是关键代码:

    </B>

    unit Servicescontrol;

       

    interface  

    uses Windows,Messages,SysUtils,Winsvc,Dialogs;

       

    function StartServices(Const SvrName:String):Boolean;

    function StopServices(Const SvrName:String):Boolean;

    function QueryServiceStatu(Const SvrName:   String):String;

    function CreateServices(Const SvrName,FilePath:String):Boolean;  

    function DeleteServices(Const SvrName: String):Boolean;  

       

    implementation

       

    //开启服务  

    function StartServices(Const   SvrName:   String):   Boolean;

    var  

          a,b:SC_HANDLE;  

            c:PChar;  

    begin  

            Result:=False;  

       

            a:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);  

       

            if a <=0 then Exit;  

       

            b:=OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);  

       

            if b <=0 then Exit;  

                try  

                  Result:=StartService(b,0,c);  

                  CloseServiceHandle(b);  

                  CloseServiceHandle(a);  

            except  

                  CloseServiceHandle(b);  

                  CloseServiceHandle(a);  

                  Exit;  

            end;  

    end;  

       

       

    //停止服务  

    function   StopServices(Const   SvrName:   String):   Boolean;

    var

            a,b:   SC_HANDLE;  

            d:   TServiceStatus;  

    begin  

            Result := False;  

       

            a :=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);  

       

            if a <=0 then Exit;  

       

            b:=OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);  

       

            if b <=0 then Exit;  

                try  

                  Result:=ControlService(b,SERVICE_CONTROL_STOP,d);  

                   CloseServiceHandle(a);  

                  CloseServiceHandle(b);  

            except  

                  CloseServiceHandle(a);  

                  CloseServiceHandle(b);  

                  Exit;  

            end;  

    end;  

       

       

    //查询当前服务的状态  

    function QueryServiceStatu(Const   SvrName:   String):   String;  

    var  

            a,b:   SC_HANDLE;  

            d:   TServiceStatus;  

    begin  

            Result := '未安装';  

       

            a := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);  

       

            if a <=0 then Exit;  

       

            b := OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);  

       

            if b <= 0 then Exit;  

                try  

                  QueryServiceStatus(b,d);  

                         if   d.dwCurrentState     =   SERVICE_RUNNING   then            

                        Result   :=   '启动'       //Run  

                  else   if   d.dwCurrentState     =   SERVICE_RUNNING   then  

                        Result   :=   'Wait'       //Runing  

                  else   if   d.dwCurrentState     =   SERVICE_START_PENDING then  

                        Result   :=   'Wait'       //Pause  

                  else   if   d.dwCurrentState     =   SERVICE_STOP_PENDING     then  

                        Result   :=   '停止'       //Pause  

                  else   if   d.dwCurrentState     =   SERVICE_PAUSED   then  

                        Result   :=   '暂停'       //Pause  

                  else   if   d.dwCurrentState     =   SERVICE_STOPPED   then  

                        Result   :=   '停止'     //Stop  

                  else   if   d.dwCurrentState     =   SERVICE_CONTINUE_PENDING     then  

                        Result   :=   'Wait'       //Pause  

                  else   if   d.dwCurrentState     =   SERVICE_PAUSE_PENDING   then  

                        Result   :=   'Wait';       //Pause  

       

                  CloseServiceHandle(a);  

                  CloseServiceHandle(b);  

            except  

                  CloseServiceHandle(a);  

                  CloseServiceHandle(b);  

                  Exit;  

            end;  

    end;  

       

       

    {建立服务}  

    function CreateServices(Const SvrName,FilePath:   String):   Boolean;  

    var  

            a,b:SC_HANDLE;  

    begin  

            Result:=False;  

                if FilePath   =''   then   Exit;  

       

            a   :=   OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE);  

       

            if   a   <=   0   then   Exit;  

            try  

                  b   :=   CreateService(a,PChar(SvrName),  

                   PChar(SvrName),  

                   SERVICE_ALL_ACCESS,  

                   SERVICE_INTERACTIVE_PROCESS   or   SERVICE_WIN32_OWN_PROCESS,  

                   SERVICE_AUTO_START,SERVICE_ERROR_NORMAL,  

                   PChar(FilePath),nil,nil,nil,nil,nil);  

                      if   b   <=   0   then   begin  

                        ShowMessage(   SysErrorMessage(   GetlastError   ));  

                        Exit;  

                  end;  

                      CloseServiceHandle(a);  

                  CloseServiceHandle(b);  

                   

                  Result   :=   True;  

            except  

                  CloseServiceHandle(a);  

                  CloseServiceHandle(b);  

                  Exit;  

            end;  

    end;  

       

       

    {卸载服务}  

    function   DeleteServices(Const   SvrName:   String):   Boolean;  

    var  

            a,b:SC_HANDLE;  

    begin  

            Result:=False;  

                a := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);  

                if a <= 0 then Exit;  

                b :=OpenService(a,PChar(SvrName),STANDARD_RIGHTS_REQUIRED);  

                if b <= 0 then Exit;  

                try  

                  Result := DeleteService(b);  

       

                  if not Result then  

                        ShowMessage(SysErrorMessage(GetlastError));  

                   CloseServiceHandle(b);  

                  CloseServiceHandle(a);  

                except  

                  CloseServiceHandle(b);  

                  CloseServiceHandle(a);  

                  Exit;  

            end;  

    end;  

    end.

    调用方法:

       {启动服务}

           StartServices(服务名);

       {停止服务}

           StopServices(服务名);

       {新建服务}

           CreateServices(服务名,exe文件路径);

       {删除服务}

             DeleteServices(服务名);

       {获取服务状态}

             string:=QueryServiceStatu(服务名);

    用Delphi创建windows服务程序

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

    (1)不用登陆进系统即可运行.

    (2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.

    笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.

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

    (1)DisplayName:服务的显示名称

    (2)Name:服务名称.

    我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到 ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令"ServiceDemo.exe /install",将提示服务安装成功!然后"net start DelphiService"将启动这个服务.进入控制面版-->管理工具-->服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先"net stop DelphiService"停止再"ServiceDemo.exe /uninstall"删除这个服务.回到Delphi7的IDE.

    我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.

    实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-->登陆,其中"允许服务与桌面交互 "是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.

    File-->New-->Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:

    unit Unit_Main;

    interface

    uses

    Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;

    type

    TDelphiService = 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

    DelphiService: TDelphiService;

    FrmMain: TFrmMain;

    implementation

    {$R *.DFM}

    procedure ServiceController(CtrlCode: DWord); stdcall;

    begin

    DelphiService.Controller(CtrlCode);

    end;

    function TDelphiService.GetServiceController: TServiceController;

    begin

    Result := ServiceController;

    end;

    procedure TDelphiService.ServiceContinue(Sender: TService;

    var Continued: Boolean);

    begin

    while not Terminated do

    begin

        Sleep(10);

        ServiceThread.ProcessRequests(False);

    end;

    end;

    procedure TDelphiService.ServiceExecute(Sender: TService);

    begin

    while not Terminated do

    begin

        Sleep(10);

        ServiceThread.ProcessRequests(False);

    end;

    end;

    procedure TDelphiService.ServicePause(Sender: TService;

    var Paused: Boolean);

    begin

    Paused := True;

    end;

    procedure TDelphiService.ServiceShutdown(Sender: TService);

    begin

    gbCanClose := true;

    FrmMain.Free;

    Status := csStopped;

    ReportStatus();

    end;

    procedure TDelphiService.ServiceStart(Sender: TService;

    var Started: Boolean);

    begin

    Started := True;

    Svcmgr.Application.CreateForm(TFrmMain, FrmMain);

    gbCanClose := False;

    FrmMain.Hide;

    end;

    procedure TDelphiService.ServiceStop(Sender: TService;

    var Stopped: Boolean);

    begin

    Stopped := True;

    gbCanClose := True;

    FrmMain.Free;

    end;

    end.

    最新回复(0)