Windows - criando servicos no NT, 2000 e xp

Top  Previous  Next

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

------- CUT-CUT-CUT-CUT ------------------------------------------------- 

(* 

  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

------- CUT-CUT-CUT-CUT ------------------------------------------------- 

(* 

  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