一个简单的服务程序的源代码

最新推荐文章于 2015-11-01 06:27:31 发布

zhnan0451

最新推荐文章于 2015-11-01 06:27:31 发布

阅读量414

点赞数

分类专栏： delphi 文章标签： user os thread service function class

本文链接：https://blog.csdn.net/zhnan0451/article/details/3377944

版权

delphi 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

这些文章在我的白度空间上已经发表过了，直接拷贝过来的。

unit Unit1;

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.

delphi6,7下调试成功