如何停止由 Win32::Daemon 启动的 Win32 服务？

我可以使用以下脚本在 Windows 10（Strawberry Perl 版本 5.30.1）上成功启动 Win32 服务：

package Win32::XYZService;
use feature qw(say);
use strict;
use warnings;
use File::Spec;
use Win32;
use Win32::Daemon;

{
    die "Bad arguments" if @ARGV != 1;
    my $action = shift @ARGV;
    my $xyz = Win32::XYZService->new();
    $xyz->action( $action );

}

sub new {
    my ( $class, %args ) = @_;
    $args{name} = 'xyz_service2';
    my ($bin, $scriptname) = Win32::GetFullPathName( $0 );
    $args{bin} = $bin;
    $args{scriptname} = $scriptname;
    $args{log_fn} = File::Spec->catfile( $bin, 'log.txt' );
    $args{time_interval} = 2000;  # callback timer interval in milliseconds
    my $self = bless \%args, $class;
    return $self;
}

sub action {
    my ($self, $action) = @_;

    if ($self->can($action)) {
        return $self->$action();
    }
    else {
        $self->log("Unknown command: $action");
        $self->log("Valid commands are: create, start, stop, delete");
        return undef;
    }
}

sub start {
    my ($self) = @_;
    $self->log("starting service..");
    system("net", "start", $self->{name});
}

sub stop {
    my ($self) = @_;

    $self->log("trying to stop service..");
    system("net", "stop", $self->{name});
}

sub _scm_start {
    my ($self) = @_;

    Win32::Daemon::RegisterCallbacks( {
        start       =>  \&_callback_start,
        timer       =>  \&_callback_timer,
        stop        =>  \&_callback_stop,
        pause       =>  \&_callback_pause,
        continue    =>  \&_callback_continue,
    } );
    Win32::Daemon::StartService( $self, $self->{time_interval} );
}

sub _callback_continue {
    my ( $event, $self) = @_;

    $self->log("callback continue");
    Win32::Daemon::State( SERVICE_RUNNING );
}

sub _callback_pause {
    my ( $event, $self) = @_;

    $self->log("callback pause");
    Win32::Daemon::State( SERVICE_PAUSED );
}

sub _callback_stop {
    my ( $event, $self) = @_;

    $self->log("callback stop");
    Win32::Daemon::State( SERVICE_STOPPED );
    Win32::Daemon::StopService();
}

sub _callback_timer {
    my ( $event, $self) = @_;

    $self->log("callback timer");
}

sub _callback_start {
    my ( $event, $self) = @_;

    $self->log("callback start");
    Win32::Daemon::State( SERVICE_RUNNING );
}

sub log {
    my ($self, $msg) = @_;

    chomp $msg;
    open(my $fh, ">>", $self->{log_fn})
        or warn("Can't append to log \"$self->{log_fn}\": $!\n"), return;
    say $fh "[PID $$] [" . localtime . "] : $msg";
    say $msg if -t STDIN;
}

sub delete {
    my ($self) = @_;
    if (Win32::Daemon::DeleteService("", $self->{name})) {
        $self->log("Successfully removed service $self->{name}");
    }
    else {
        $self->log("Failed to remove service: " . Win32::FormatMessage( Win32::Daemon::GetLastError()));
    }
}

sub create {
    my ($self) = @_;
    my $service_path = $^X;
    my $service_params = File::Spec->catfile($self->{bin}, $self->{scriptname});
    $service_params .= ' _scm_start';  # Service control manager start
    my %service_info = (
        name            => $self->{name},
        display         => 'xyz_display',
        path            => $service_path,
        description     => 'xyz_description',
        parameters      => $service_params,
        service_type    => SERVICE_WIN32_OWN_PROCESS,
        start_type      => SERVICE_AUTO_START
    );

    if (Win32::Daemon::CreateService( \%service_info)) {
        $self->log("Successfully added service $service_info{name}");
    }
    else {
        $self->log("Failed to add service: " . Win32::FormatMessage( Win32::Daemon::GetLastError()));
    }
}

如果我以管理员身份从命令提示符运行此脚本：

>perl xyz_service.pl create
Successfully added service xyz_service2

>perl xyz_service.pl start
starting service..
The xyz_display service is starting.
The xyz_display service was started successfully.

>type log.txt
[PID 8844] [Wed Jul  1 11:33:05 2020] : Successfully added service xyz_service2
[PID 10552] [Wed Jul  1 11:33:42 2020] : starting service..
[PID 12076] [Wed Jul  1 11:33:42 2020] : callback start
[PID 12076] [Wed Jul  1 11:33:44 2020] : callback timer
[PID 12076] [Wed Jul  1 11:33:46 2020] : callback timer
[PID 12076] [Wed Jul  1 11:33:48 2020] : callback timer
[PID 12076] [Wed Jul  1 11:33:50 2020] : callback timer
[PID 12076] [Wed Jul  1 11:33:52 2020] : callback timer
[PID 12076] [Wed Jul  1 11:33:54 2020] : callback timer

>perl xyz_service.pl stop
stopping service..
The requested pause, continue, or stop is not valid for this service.
More help is available by typing NET HELPMSG 2191.

我怎样才能停止该服务？

该模块应该使用SetServiceStatus向 Windows 发出信号，表明它可以处理关闭事件。在旧版本的 Windows 中也是如此。但是，它在 Windows 10（及更高版本）和 Windows Server 2016（及更高版本）中无法做到这一点。

此失败是由于缺少默认子句造成的switch陈述在模块的DllMain in Demon.xs。由于这个问题，gdwControlsAccepted最终得到一个不正确的值。

修正后的switch:

            switch( gsOSVerInfo.dwMajorVersion )
            {
                default:
                    // We have Windows Vista or newer
                    //  The following constants only work on Vista and higher:
                    //      SERVICE_ACCEPT_PRESHUTDOWN
                    //
#ifdef SERVICE_CONTROL_PRESHUTDOWN
                    gdwControlsAccepted |= SERVICE_ACCEPT_PRESHUTDOWN;
#endif  // SERVICE_CONTROL_PRESHUTDOWN

                case 5:
                    // We have Windows 2000 or XP
                    //  The following constants only work on Win2k and higher:
                    //      SERVICE_ACCEPT_PARAMCHANGE
                    //      SERVICE_ACCEPT_NETBINDCHANGE
                    //
                    gdwControlsAccepted |= SERVICE_ACCEPT_PARAMCHANGE  
                                        |  SERVICE_ACCEPT_NETBINDCHANGE;

                case 4:
                case 3:
                case 2:
                case 1:
                case 0:
                    // NT 4.0
                    gdwControlsAccepted |= SERVICE_ACCEPT_STOP 
                                        |  SERVICE_ACCEPT_PAUSE_CONTINUE
                                        |  SERVICE_ACCEPT_SHUTDOWN;
            }

我没有测试过这个。请测试并提交错误报告。