unit1.pas

使用Delphi5制作Tservice的例子

unit Unit1;
(*
  Test Service Application - 12.28.99 - David Lively
  Email [e-mail]

  A simple service application that can be started, paused, continued, and stopped.
  Beeps once every two seconds when executing. Install by running
  "service /install" from the command line, then manipulate the service with:

  START)    net start "test service"
  STOP)     net stop  "test service"
  PAUSE)    net pause "test service"
  CONTINUE) net continue "test service"

  To uninstall, run "service /uninstall"

*)
interface

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

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

var
  TestService: TTestService;

implementation

{$R *.DFM}

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

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

procedure TTestService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  { Alert the user }
  ShowMessage('OnStart');
  { tell the OS that we're starting }
  Started := TRUE;
end;

procedure TTestService.ServiceExecute(Sender: TService);
begin
  ShowMessage('OnExecute');
  { Execute until we're told to stop }
  while not Terminated do begin
    { Only act if we're not paused }
    if not fPaused then begin
      { wait 2 seconds }
      Sleep(2000);
      { beep }
      MessageBeep(0);
    end; { if not ServiceThread.Suspended }
    { Let other threads execute }
    ServiceThread.ProcessRequests(FALSE);
  end; { while not Terminated }
end;

procedure TTestService.ServiceBeforeInstall(Sender: TService);
begin
  ShowMessage('BeforeInstall');
end;

procedure TTestService.ServiceAfterInstall(Sender: TService);
begin
  ShowMessage('After Install');
end;

procedure TTestService.ServiceAfterUninstall(Sender: TService);
begin
  ShowMessage('After Uninstall');
end;

procedure TTestService.ServiceBeforeUninstall(Sender: TService);
begin
  ShowMessage('Before Uninstall');
end;

procedure TTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  { Tell the service thread to terminate }
  ServiceThread.Terminate;
  { Tell the OS that we're stopping }
  Stopped := TRUE;
  { Alert the user }
  ShowMessage('Stop');
end;

procedure TTestService.ServiceShutdown(Sender: TService);
begin
  ShowMessage('Shutdown');
end;

procedure TTestService.ServicePause(Sender: TService; var Paused: Boolean);
begin
  { tell OS that pause was successful }
  Paused := True;
  { set are pause flag so Execute loop doesn't do anything }
  fPaused := TRUE;
  { Alert the user visually }
  ShowMessage('Pause');
end;

procedure TTestService.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  { Tell the OS that the Continue was successful }
  Continued := True;
  { Turn our internal pause flag off }
  fPaused := FALSE;
  { alert the user visually }
  ShowMessage('Continue');
end;

end.