Question

在{{3}}的文档中，它说：

start_type一个整数，指定如何（或是否）启动服务。默认值为SERVICE_AUTO_START。

我没有找到任何说明延迟自动启动值的地方。

查看Win32 :: Daemon背后的源代码可能有所帮助，但我不知道如何找到它。显然它是通过perl bootstrap函数加载的。

Answer 1

没有任何价值可以传递给CreateService()的start_type参数，它会做你想要的。您需要按ChangeServiceConfig2()致电this answer。您可以使用Win32::API来调用它。

代码：

use My::Win32::Service qw( :ALL );

my $ServiceName = ...;

my $SCManager;
my $Service ;

if (!eval {
   $SCManager = OpenSCManager(undef, undef, SC_MANAGER_ALL_ACCESS)
      or die("Can't open the service control manager: $^E\n");

   $Service = OpenService($SCManager, $ServiceName, SERVICE_CHANGE_CONFIG)
      or die("Can't open the service: $^E\n");

   ChangeServiceConfig2($Service, SERVICE_CONFIG_DELAYED_AUTO_START_INFO, pack_SERVICE_DELAYED_AUTO_START_INFO(1))
      or die("Can't set the service to delayed auto-start: $^E\n");

   CloseServiceHandle($Service);
   CloseServiceHandle($SCManager);

   return 1;  # No exception
}) {
   my $e = $@;
   CloseServiceHandle($Service)   if $Service;
   CloseServiceHandle($SCManager) if $SCManager;
   die($e);
}

My/Win32/Service.pm：

package My::Win32::Service;

use strict;
use warnings;
use feature qw( state );

use Encode     qw( decode );
use Exporter   qw( import );
use Win32::API qw( );

our %EXPORT_TAGS;
our @EXPORT_OK = qw(
   OpenSCManager
   OpenService
   CloseServiceHandle
   ChangeServiceConfig2
   pack_SERVICE_DELAYED_AUTO_START_INFO
);

# -----

use constant {
   GENERIC_READ    => 0x80000000,
   GENERIC_WRITE   => 0x40000000,
   GENERIC_EXECUTE => 0x20000000,
   GENERIC_ALL     => 0x10000000,
};

$EXPORT_TAGS{GENERIC} = [qw(
   GENERIC_READ
   GENERIC_WRITE
   GENERIC_EXECUTE
   GENERIC_ALL
)];

use constant {
   STANDARD_RIGHTS_REQUIRED => 0xF0000,
};

push @EXPORT_OK, qw(
   STANDARD_RIGHTS_REQUIRED
);

use constant {
   SC_MANAGER_CREATE_SERVICE     => 0x0002,
   SC_MANAGER_CONNECT            => 0x0001,
   SC_MANAGER_ENUMERATE_SERVICE  => 0x0004,
   SC_MANAGER_LOCK               => 0x0008,
   SC_MANAGER_MODIFY_BOOT_CONFIG => 0x0020,
   SC_MANAGER_QUERY_LOCK_STATUS  => 0x0010,
};

use constant {
   SC_MANAGER_ALL_ACCESS =>
        STANDARD_RIGHTS_REQUIRED
      | SC_MANAGER_CREATE_SERVICE
      | SC_MANAGER_CONNECT
      | SC_MANAGER_ENUMERATE_SERVICE
      | SC_MANAGER_LOCK
      | SC_MANAGER_MODIFY_BOOT_CONFIG
      | SC_MANAGER_QUERY_LOCK_STATUS,
};

$EXPORT_TAGS{SC_MANAGER} = [qw(
   SC_MANAGER_CREATE_SERVICE
   SC_MANAGER_CONNECT
   SC_MANAGER_ENUMERATE_SERVICE
   SC_MANAGER_LOCK
   SC_MANAGER_MODIFY_BOOT_CONFIG
   SC_MANAGER_QUERY_LOCK_STATUS
   SC_MANAGER_ALL_ACCESS
)];

use constant {
   SERVICE_CHANGE_CONFIG        => 0x0002,
   SERVICE_ENUMERATE_DEPENDENTS => 0x0008,
   SERVICE_INTERROGATE          => 0x0080,
   SERVICE_PAUSE_CONTINUE       => 0x0040,
   SERVICE_QUERY_CONFIG         => 0x0001,
   SERVICE_QUERY_STATUS         => 0x0004,
   SERVICE_START                => 0x0010,
   SERVICE_STOP                 => 0x0020,
   SERVICE_USER_DEFINED_CONTROL => 0x0100,
};

use constant {
   SERVICE_ALL_ACCESS =>
        STANDARD_RIGHTS_REQUIRED
      | SERVICE_CHANGE_CONFIG
      | SERVICE_ENUMERATE_DEPENDENTS
      | SERVICE_INTERROGATE
      | SERVICE_PAUSE_CONTINUE
      | SERVICE_QUERY_CONFIG
      | SERVICE_QUERY_STATUS
      | SERVICE_START
      | SERVICE_STOP
      | SERVICE_USER_DEFINED_CONTROL;
};

$EXPORT_TAGS{SERVICE} = [qw(
   SERVICE_CHANGE_CONFIG
   SERVICE_ENUMERATE_DEPENDENTS
   SERVICE_INTERROGATE
   SERVICE_PAUSE_CONTINUE
   SERVICE_QUERY_CONFIG
   SERVICE_QUERY_STATUS
   SERVICE_START
   SERVICE_STOP
   SERVICE_USER_DEFINED_CONTROL
   SERVICE_ALL_ACCESS
)];

use constant {
   SERVICE_CONFIG_DELAYED_AUTO_START_INFO  => 3,
   SERVICE_CONFIG_DESCRIPTION              => 1,
   SERVICE_CONFIG_FAILURE_ACTIONS          => 2,
   SERVICE_CONFIG_FAILURE_ACTIONS_FLAG     => 4,
   SERVICE_CONFIG_PREFERRED_NODE           => 9,
   SERVICE_CONFIG_PRESHUTDOWN_INFO         => 7,
   SERVICE_CONFIG_REQUIRED_PRIVILEGES_INFO => 6,
   SERVICE_CONFIG_SERVICE_SID_INFO         => 5,
   SERVICE_CONFIG_TRIGGER_INFO             => 8,
   SERVICE_CONFIG_LAUNCH_PROTECTED         => 12,
};

$EXPORT_TAGS{SERVICE_CONFIG} = [qw(
   SERVICE_CONFIG_DELAYED_AUTO_START_INFO
   SERVICE_CONFIG_DESCRIPTION
   SERVICE_CONFIG_FAILURE_ACTIONS
   SERVICE_CONFIG_FAILURE_ACTIONS_FLAG
   SERVICE_CONFIG_PREFERRED_NODE
   SERVICE_CONFIG_PRESHUTDOWN_INFO
   SERVICE_CONFIG_REQUIRED_PRIVILEGES_INFO
   SERVICE_CONFIG_SERVICE_SID_INFO
   SERVICE_CONFIG_TRIGGER_INFO
   SERVICE_CONFIG_LAUNCH_PROTECTED
)];

{
   my %export_ok;
   ++$export_ok{$_}
      for
         @EXPORT_OK,
         ( map {@$_, values %EXPORT_TAGS );

   @EXPORT_OK = sort keys %export_ok;
   $EXPORT_TAGS{ALL} = \@EXPORT_OK;
}

# -----

# https://msdn.microsoft.com/en-ca/library/windows/desktop/aa383751(v=vs.85).aspx
# typedef int           BOOL;
# typedef unsigned long DWORD;
# typedef PVOID         HANDLE;
# typedef void*         PVOID;

# *** I'm pretty sure some of these are wrong on 64-bit builds of Perl. ***

use constant {
   WAPI_FORMAT_PTR    => 'I',                PACK_FORMAT_PTR    => 'i',
};

use constant {
   WAPI_FORMAT_BOOL   => 'I',                PACK_FORMAT_BOOL   => 'i',
   WAPI_FORMAT_DWORD  => 'N',                PACK_FORMAT_DWORD  => 'L',
   WAPI_FORMAT_HANDLE => WAPI_FORMAT_PVOID,  PACK_FORMAT_HANDLE => PACK_FORMAT_PTR,
};

# -----

sub encode_LPCWSTR {
   my ($s) = @_;
   return undef if !defined($s);
   return encode('UTF-16le', $s."\0");
}


# Inefficient. Needs a C implementation.
sub decode_LPCWSTR {
   my ($ptr) = @_;

   return undef if !$ptr;

   my $sW = '';
   while (1){
      my $chW = unpack('P2', pack(PACK_FORMAT_PTR, $ptr));
      last if $chW eq "\0\0";
      $sW .= $chW;
      $ptr += 2;
   }

   return decode('UTF-16le', $sW);
}

# -----

sub pack_SERVICE_DELAYED_AUTO_START_INFO {
   my ($DelayedAutostart) = @_;
   return pack(PACK_FORMAT_BOOL, $DelayedAutostart ? 1 : 0);
}

# -----

# https://msdn.microsoft.com/en-us/library/windows/desktop/ms684323(v=vs.85).aspx
# On error, returns false. Use $^E to get the error message.
# Close returned handle using CloseServiceHandle.
sub OpenSCManager {
   my ($MachineName, $DatabaseName, $DesiredAccess) = @_;

   my $packed_MachineName  = encode_LPCWSTR($MachineName);
   my $packed_DatabaseName = encode_LPCWSTR($DatabaseName);

   state $OpenSCManager = Win32::API->new(
      'advapi32.dll',
      'OpenSCManagerW',
      'P' . 'P' . WAPI_FORMAT_DWORD,
      WAPI_FORMAT_HANDLE,
   );

   return $OpenSCManager->Call($packed_MachineName, $packed_DatabaseName, $DesiredAccess);
}


# https://msdn.microsoft.com/en-us/library/windows/desktop/ms684330(v=vs.85).aspx
# On error, returns false. Use $^E to get the error message.
# Close returned handle using CloseServiceHandle.
sub OpenService(
   my ($SCManager, $ServiceName, $DesiredAccess) = @_;

   my $packed_ServiceName  = encode_LPCWSTR($ServiceName);

   state $OpenService = Win32::API->new(
      'advapi32.dll',
      'OpenServiceW',
      WAPI_FORMAT_HANDLE . 'P' . WAPI_FORMAT_DWORD,
      WAPI_FORMAT_HANDLE,
   );

   return $OpenSCManager->Call($packed_MachineName, $packed_DatabaseName, $DesiredAccess);
}


# https://msdn.microsoft.com/en-us/library/windows/desktop/ms682028(v=vs.85).aspx
# On error, returns false. Use $^E to get the error message.
sub CloseServiceHandle {
   my ($SCObject) = @_;

   state $CloseServiceHandle = Win32::API->new(
      'advapi32.dll',
      'CloseServiceHandle',
      WAPI_FORMAT_HANDLE,
      WAPI_FORMAT_BOOL,
   );

   return $CloseServiceHandle->Call($SCObject);
}


# https://msdn.microsoft.com/en-us/library/windows/desktop/ms681988(v=vs.85).aspx
# Info must be a packed structure.
# On error, returns false. Use $^E to get the error message.
sub ChangeServiceConfig2 {
   my ($Service, $InfoLevel, $packed_Info) = @_;

   state $CloseServiceHandle = Win32::API->new(
      'advapi32.dll',
      'CloseServiceHandle',
      WAPI_FORMAT_HANDLE . WAPI_FORMAT_DWORD . 'P',
      WAPI_FORMAT_BOOL,
   );

   return $ChangeServiceConfig2->Call($Service, $InfoLevel, $packed_Info);
}

# -----

1;

完全未经测试。事实上，我认为它在Perl的64位版本中存在问题。

什么是延迟自动启动的Win32 :: Daemon上下文哈希关键字？

1 个答案: