zoukankan      html  css  js  c++  java
  • delphi 通过线程实现Windows服务

    Problem/Question/Abstract:
    Delphi 5&6 has a template project for services, but it is incomplete. This example builds on that template and completes the service. It also shows how to start a thread that beeps every 2 seconds. You can use this as a base when developing servers as services.
    Answer:
    This example shows how to use the service template in delphi, taking it a step further and making a complete example. The source for this is included in the ntservice.zip file.
    Coded under D6, but works for D5 if you copy the source parts after creating a template service.
    Below are all the source files listed one by one.
    To test the source, create a Service with Delphi, and pase these sources on top of the automatically generated source.
    program NTService;
    uses
      SvcMgr,
      NTServiceMain in 'Units\NTServiceMain.pas' {ExampleService: TService},
      NTServiceThread in 'Units\NTServiceThread.pas';
    {$R *.RES}
    begin
      Application.Initialize;
      Application.CreateForm(TExampleService, ExampleService);
      Application.Run;
    end.
    {*
      Windows Service Template
      ========================
      Author          Kim Sandell
                      emali:
    kim.sandell@nsftele.com
      Disclaimer      Freeware. Use and abuse at your own risk.
      Description     A Windows NT Service skeleton with a thread.
                      Works in WinNT 4.0, Win 2K, and Win XP Pro
                      The NTServiceThread.pas contains the actual
                      thread that is started under the service.
                      When you want to code a service, put the code in
                      its Execute() method.
      Example         To test the service, install it into the SCM with
                      the InstallService.bat file. The go to the Service
                      Control Manager and start the service.
                      The Interval can be set to execute the Example Beeping
                      every x seconds. It depends on the application if it
                      needs a inerval or not.
      Notes           This example has the service startup options set to
                      MANUAL. If you want to make a service that starts
                      automatically with windows then you need to change this.
                      BE CAREFULT ! If your application hangs when running as a
                      service THERE IS NO WAY to terminate the application.
      History     Description
      ==========  ============================================================
      24.09.2002  Initial version
    *}
    unit NTServiceMain;
    interface
    uses
      Windows, Messages, SysUtils, Classes, SvcMgr,
      NTServiceThread;
    type
      TExampleService = class(TService)
        procedure ServiceExecute(Sender: TService);
        procedure ServiceStart(Sender: TService; var Started: Boolean);
        procedure ServiceStop(Sender: TService; var Stopped: Boolean);
        procedure ServicePause(Sender: TService; var Paused: Boolean);
        procedure ServiceContinue(Sender: TService; var Continued: Boolean);
        procedure ServiceShutdown(Sender: TService);
      private
        { Private declarations }
        fServicePri: Integer;
        fThreadPri: Integer;
        { Internal Start & Stop methods }
        function _StartThread(ThreadPri: Integer): Boolean;
        function _StopThread: Boolean;
      public
        { Public declarations }
        NTServiceThread: TNTServiceThread;
        function GetServiceController: TServiceController; override;
      end;
    var
      ExampleService: TExampleService;
    implementation
    {$R *.DFM}
    procedure ServiceController(CtrlCode: DWord); stdcall;
    begin
      ExampleService.Controller(CtrlCode);
    end;
    function TExampleService.GetServiceController: TServiceController;
    begin
      Result := ServiceController;
    end;
    procedure TExampleService.ServiceExecute(Sender: TService);
    begin
      { Loop while service is active in SCM }
      while not Terminated do
      begin
        { Process Service Requests }
        ServiceThread.ProcessRequests(False);
        { Allow system some time }
        Sleep(1);
      end;
    end;
    procedure TExampleService.ServiceStart(Sender: TService; var Started: Boolean);
    begin
      { Default Values }
      Started := False;
      fServicePri := NORMAL_PRIORITY_CLASS;
      fThreadPri := Integer(tpLower);
      { Set the Service Priority }
      case fServicePri of
        0: SetPriorityClass(GetCurrentProcess, IDLE_PRIORITY_CLASS);
        1: SetPriorityClass(GetCurrentProcess, NORMAL_PRIORITY_CLASS);
        2: SetPriorityClass(GetCurrentProcess, HIGH_PRIORITY_CLASS);
        3: SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
      end;
      { Attempt to start the thread, if it fails free it }
      if _StartThread(fThreadPri) then
      begin
        { Signal success back }
        Started := True;
      end
      else
      begin
        { Signal Error back }
        Started := False;
        { Stop all activity }
        _StopThread;
      end;
    end;
    procedure TExampleService.ServiceStop(Sender: TService;
      var Stopped: Boolean);
    begin
      { Try to stop the thread - signal results back }
      Stopped := _StopThread;
    end;
    procedure TExampleService.ServicePause(Sender: TService; var Paused: Boolean);
    begin
      { Attempt to PAUSE the thread }
      if Assigned(NTServiceThread) and (not NTServiceThread.Suspended) then
      begin
        { Suspend the thread }
        NTServiceThread.Suspend;
        { Return results }
        Paused := (NTServiceThread.Suspended = True);
      end
      else
        Paused := False;
    end;
    procedure TExampleService.ServiceContinue(Sender: TService;
      var Continued: Boolean);
    begin
      { Attempt to RESUME the thread }
      if Assigned(NTServiceThread) and (NTServiceThread.Suspended) then
      begin
        { Suspend the thread }
        if NTServiceThread.Suspended then
          NTServiceThread.Resume;
        { Return results }
        Continued := (NTServiceThread.Suspended = False);
      end
      else
        Continued := False;
    end;
    procedure TExampleService.ServiceShutdown(Sender: TService);
    begin
      { Attempt to STOP (Terminate) the thread }
      _StopThread;
    end;
    function TExampleService._StartThread(ThreadPri: Integer): Boolean;
    begin
      { Default result }
      Result := False;
      { Create Thread and Set Default Values }
      if not Assigned(NTServiceThread) then
      try
        { Create the Thread object }
        NTServiceThread := TNTServiceThread.Create(True);
        { Set the Thread Priority }
        case ThreadPri of
          0: NTServiceThread.Priority := tpIdle;
          1: NTServiceThread.Priority := tpLowest;
          2: NTServiceThread.Priority := tpLower;
          3: NTServiceThread.Priority := tpNormal;
          4: NTServiceThread.Priority := tpHigher;
          5: NTServiceThread.Priority := tpHighest;
        end;
        { Set the Execution Interval of the Thread }
        NTServiceThread.Interval := 2;
        { Start the Thread }
        NTServiceThread.Resume;
        { Return success }
        if not NTServiceThread.Suspended then
          Result := True;
      except
        on E: Exception do
          ; // TODO: Exception Logging
      end;
    end;
    function TExampleService._StopThread: Boolean;
    begin
      { Default result }
      Result := False;
      { Stop and Free Thread }
      if Assigned(NTServiceThread) then
      try
        { Terminate thread }
        NTServiceThread.Terminate;
        { If it is suspended - Restart it }
        if NTServiceThread.Suspended then
          NTServiceThread.Resume;
        { Wait for it to finish }
        NTServiceThread.WaitFor;
        { Free & NIL it }
        NTServiceThread.Free;
        NTServiceThread := nil;
        { Return results }
        Result := True;
      except
        on E: Exception do
          ; // TODO: Exception Logging
      end
      else
      begin
        { Return success - Nothing was ever started ! }
        Result := True;
      end;
    end;
    end.
    {*
      A Windows NT Service Thread
      ===========================
      Author          Kim Sandell
                      Email:
    kim.sandell@nsftele.com
    *}
    unit NTServiceThread;
    interface
    uses
      Windows, Messages, SysUtils, Classes;
    type
      TNTServiceThread = class(TThread)
      private
        { Private declarations }
      public
        { Public declarations }
        Interval: Integer;
        procedure Execute; override;
      published
        { Published declarations }
      end;
    implementation
    { TNTServiceThread }
    procedure TNTServiceThread.Execute;
    var
      TimeOut: Integer;
    begin
      { Do NOT free on termination - The Serivce frees the Thread }
      FreeOnTerminate := False;
      { Set Interval }
      TimeOut := Interval * 4;
      { Main Loop }
      try
        while not Terminated do
        begin
          { Decrement timeout }
          Dec(TimeOut);
          if (TimeOut = 0) then
          begin
            { Reset timer }
            TimeOut := Interval * 4;
            { Beep once per x seconds }
            Beep;
          end;
          { Wait 1/4th of a second }
          Sleep(250);
        end;
      except
        on E: Exception do
          ; // TODO: Exception logging...
      end;
      { Terminate the Thread - This signals Terminated=True }
      Terminate;
    end;
    end.
  • 相关阅读:
    自己写的一个读取execl的帮助类
    手动获取spring的ApplicationContext和bean对象
    前端开发不容错过的jQuery图片滑块插件(转)
    细说HTML元素的隐藏和显示
    DIV+CSS布局重新学习之使用A标签和CSS制作按钮
    opencv2函数学习之flip:实现图像翻转
    DWZ中Tree树形菜单的treeCheck如何获取返回值解决方案
    DWZ中刷新dialog的方案解决
    DWZ与KindEditor编辑器的整合
    ViewModel在MVC3中的应用:实现多字段表格的部分更新
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/1314115.html
Copyright © 2011-2022 走看看