遅延自動起動のWin32 :: Daemonコンテキストハッシュキーワードは何ですか？ <a href="http://search.cpan.org/perldoc?Win32::Daemon" rel="nofollow">Win32::Daemon</a>のドキュメントで

Question

は、それは言う：

start_typeどのように（かどうか）を指定する整数サービスが開始されます。デフォルトはSERVICE_AUTO_STARTです。

の値が何であるかはわかりません。です。

Win32 :: Daemonの背後にあるソースを見れば助けになるかもしれませんが、それを見つける方法はわかりません。明らかに、perlのブートストラップ機能によってロードされています。

Answer 1

CreateService()のstart_typeパラメータに渡すことができる値はありません。 this answerのようにChangeServiceConfig2()に電話する必要があります。 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ビットビルドではバグだと思います。