Perl 如何停止使用Win32:：Daemon启动的Win32服务？

我能够使用以下脚本在Windows 10（草莓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.

---

如何停止服务？

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

此故障是由于模块的

DllMain

中的

Demon.xs

中缺少默认子句而导致的。由于此问题，

gdwControlsAccepted

的值不正确

已纠正的

开关

：

开关（gsOSVerInfo.dwMajorVersion）
{
违约：
//我们有Windows Vista或更新版本
//以下常量仅适用于Vista及更高版本：
//服务接收预停机
//
#ifdef维修控制预停机
GDWControlsAccept |=服务|接受|预停机；
#endif//SERVICE\u CONTROL\u PRESHUTDOWN
案例5：
//我们有Windows 2000或XP
//以下常量仅适用于Win2k及更高版本：
//服务\接受\参数更改
//服务(接受)(更改)
//
gdwControlsAccepted |=服务|接受|参数更改
|服务接受变更；
案例4：
案例3：
案例2：
案例1：
案例0：
//新界4.0
GDWControlsAccept |=服务|接受|停止
|服务\u接受\u暂停\u继续
|服务、接受、关闭；
}

---

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

使用Windows UI或“net stop[服务名称]”命令行：这将调用您的_callback\u stop方法。事实上，一旦注册了服务，就不需要使用perl命令来启动、恢复、暂停等等。但是Windows UI或命令行，甚至Windows APIs从我目前所能说的来看，它并不是传递给您的；它是通过使用传递的，而Win32:：Daemon没有为此提供接口。实际上，

Win32:：Daemon:：State

最终调用了

SetServiceStatus

，但它没有设置相关字段（

dwControlsAccepted

），更不用说提供为其指定值的方法了。@Håkon Hægland，您可以使用Win32:：API调用

SetServiceStatus

而不是使用W:：D的包装器，但是1）如果使用W:：D的计时器功能，可能会导致问题，2）在W:：D中，

SetServiceStatus

被调用得到处都是，因此我认为通过直接调用它设置的标志有被清除的风险。///因此，我认为需要对W:：D进行更改。这肯定是服务应用程序和

net stop

所使用的。因此，虽然链接文档显示了如何停止服务而不执行

net stop

，但我认为这无助于解决您的问题。在@Håkon Hæglandaded Oh的帮助下，我没有看到您有更好的switch语句排序版本。。也许我会重写它later@Håkon Hægland，我的密码错了——修正了！——但有一种更简单的解决方案，尽管如此