uciaservicetools.pas

一個強大的定時服務程序

unit uCiaServiceTools;

interface

uses
   SysUtils, Classes, Windows, SvcMgr, WinSvc;

type
  TCiaService = class(TService)
  protected
    procedure Start(Sender: TService; var Started: boolean);
    procedure Stop(Sender: TService; var Stopped: boolean);
    procedure Execute(Sender: TService);
  public
    function GetServiceController: TServiceController; override;
    constructor CreateNew(AOwner: TComponent; Dummy: integer = 0); override;
    procedure CreateForm(InstanceClass: TComponentClass; var Reference);
    procedure Run;
  end;

function CiaStartService(DisplayName: string): Boolean;
function CiaIsService: boolean;

var
  CiaService: TCiaService;

implementation

var
   FIsService: boolean;
   FServiceName: string;
   FDisplayName: string;

//------------------------------------------------------------------------------
//---- TCiaService -------------------------------------------------------------
//------------------------------------------------------------------------------
procedure ServiceController(CtrlCode: dword); stdcall;
begin
   CiaService.Controller(CtrlCode);
end;

//------------------------------------------------------------------------------
function TCiaService.GetServiceController: TServiceController;
begin
   result := ServiceController;
end;

//------------------------------------------------------------------------------
procedure TCiaService.CreateForm(InstanceClass: TComponentClass; var Reference);
begin
   SvcMgr.Application.CreateForm(InstanceClass, Reference);
end;

//------------------------------------------------------------------------------
procedure TCiaService.Run;
begin
   SvcMgr.Application.Run;
end;

//------------------------------------------------------------------------------
constructor TCiaService.CreateNew(AOwner: TComponent; Dummy: integer);
begin
   inherited;
   AllowPause  := False;
   Interactive := True;
   DisplayName := FDisplayName;
   Name        := FServiceName;
   OnStart     := Start;
   OnStop      := Stop;
end;

//------------------------------------------------------------------------------
procedure TCiaService.Start(Sender: TService; var Started: boolean);
begin
   Started := True;
end;

//------------------------------------------------------------------------------
procedure TCiaService.Execute(Sender: TService);
begin
   while not Terminated do
      ServiceThread.ProcessRequests(True);
end;

//------------------------------------------------------------------------------
procedure TCiaService.Stop(Sender: TService; var Stopped: boolean);
begin
   Stopped := True;
end;

//------------------------------------------------------------------------------
//---- Various -----------------------------------------------------------------
//------------------------------------------------------------------------------
function CiaIsService: boolean;
begin
   Result := FIsService;
end;

//------------------------------------------------------------------------------
function CiaStartService(DisplayName: string): Boolean;
var
   Mgr, Svc: Integer;
   UserName, ServiceStartName: string;
   Config: Pointer;
   Size: DWord;
   n: integer;
begin
   FDisplayName := DisplayName;
   FServiceName := DisplayName;

   for n := 1 to Length(FServiceName) do
      if FServiceName[n] = ' ' then
         FServiceName[n] := '_';

   FIsService := FindCmdLineSwitch('install',   ['-','\','/'], True) or
                 FindCmdLineSwitch('uninstall', ['-','\','/'], True);

   if FIsService then begin
      SvcMgr.Application.Initialize;
      CiaService := TCiaService.CreateNew(SvcMgr.Application, 0);
      Result := True;
      Exit;
   end;

   Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
   if Mgr <> 0 then begin
      Svc := OpenService(Mgr, PChar(FServiceName), SERVICE_ALL_ACCESS);
      FIsService := Svc <> 0;
      if FIsService then begin
         QueryServiceConfig (Svc, nil, 0, Size);
         Config := AllocMem(Size);
         try
            QueryServiceConfig(Svc, Config, Size, Size);
            ServiceStartName := PQueryServiceConfig(Config)^.lpServiceStartName;
            if CompareText(ServiceStartName, 'LocalSystem') = 0 then
               ServiceStartName := 'SYSTEM';
         finally
            Dispose(Config);
         end;
         CloseServiceHandle(Svc);
      end;
      CloseServiceHandle(Mgr);
   end;

   if FIsService then begin
      Size := 256;
      SetLength(UserName, Size);
      GetUserName(PChar(UserName), Size);
      SetLength(UserName, StrLen(PChar(UserName)));
      FIsService := CompareText(UserName, ServiceStartName) = 0;
   end;

   Result := FIsService;

   if FIsService then begin
      SvcMgr.Application.Initialize;
      CiaService := TCiaService.CreateNew(SvcMgr.Application, 0);
   end;
end;


end.