大悟还俗

邮箱 key_ok@qq.com 我的收集 http://pan.baidu.com/share/home?uk=1177427271
posts - 236, comments - 8, trackbacks - 0, articles - 0
  新随笔  :: 联系 :: 订阅 订阅  :: 管理

写一个服务程序的模板

Posted on 2013-10-09 11:58  大悟还俗  阅读(...)  评论(... 编辑 收藏
//unit UntService;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  DB, ADODB,Registry,ActiveX;
type
  TService2 = class(TService)
    con1: TADOConnection;
    procedure ServiceExecute(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;
var
  Service2: TService2;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service2.Controller(CtrlCode);
end;
function TService2.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;
procedure TService2.ServiceExecute(Sender: TService);
begin
 while not Terminated do
  begin
    ServiceThread.ProcessRequests(True);
    //do some thing;
    //这里VCL创建了一个线程,并在线程中实现了一个消息泵来接收消息
    //你可以把循环检测的事件加到这里
    Sleep(100);
  end;
end;
procedure TService2.ServiceAfterInstall(Sender: TService);
var
  Registry: TRegistry;
  key: String;
begin
  Registry  := TRegistry.Create;
  try
    Registry.RootKey := HKEY_LOCAL_MACHINE;
    key := 'System/CurrentControlSet/Services/' + Name;
    if Registry.KeyExists(key) then
    begin
      Registry.OpenKey(key, True);
      Registry.WriteString('Description', 'XXXXXXXXXXXXX');
      Registry.CloseKey;
    end;
  finally
    Registry.Free;
  end;
end;
procedure TService2.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  Continued := True;
end;
procedure TService2.ServiceStart(Sender: TService; var Started: Boolean);
begin
  CoInitialize(nil);
  try
    con1.Open;
  except
    LogMessage('Database connection error');
  end;
  Started := True;
end;
procedure TService2.ServicePause(Sender: TService; var Paused: Boolean);
begin
  Paused := True;
end;
end. 
View Code