|
我写了一段代码,使用perlsvc编译后,运行时服务可以正常注册、卸载,但不能“启动”。启动时报错“xxxxxx fail to start” ,我使用 --debug 跟踪调试 ,未发现错误。
代码主要内容如下: 请指教!!(刚才忘了说明 需要在.exe 的同级目录下放一个urllist.txt文件,该文件一行为一个词)
package PerlSvc;
use strict;
use warnings;
use FileHandle;
$" = "-";
$|=1;
my $strFilename = "UrlList.txt";
my $splicetime = 60 * 15;
my $service = "TrackSvc";
my @options = ('fileName' => \$strFilename,
'Time' => \$splicetime);
(my $progname = $0) =~ s/.*?([^\\]+?)(\.\w+)$/$1/;
our(%Config,$Verbose);
unless (defined &ContinueRun) {
# Don't delay the very first time ContinueRun() is called
my $sleep;
*ContinueRun = sub {
Win32::Sleep(1000*shift) if $sleep && @_;
$sleep = 1;
return 1
};
*RunningAsService = sub {return 0};
# Interactive() would be called automatically if we were running
# the compiled PingSvc.exe
Interactive();
}
sub unsupported {
my $option = shift;
die "The '--$option' option is only supported in the compiled script.\n";
}
sub get_options {
require Getopt: ong;
my @options = @_;
my $usage = pop @options;
$SIG{__WARN__} = sub { print "$usage\n$_[0]"; exit 1 };
Getopt: ong::GetOptions(@options);
$SIG{__WARN__} = 'DEFAULT';
}
sub configure {
%Config = (ServiceName => $service,
DisplayName => "GetHtml $service",
Parameters => "--fileName $strFilename --Time $splicetime",
Description => "Get Html"
);
}
sub Interactive {
# These entries are only used when the program is run with
# `perl PingSvc.pl` and is not compiled into a service yet.
push(@options,
'help' => \&Help,
'install' => \&unsupported,
'remove' => \&unsupported);
# Setup the %Config hash based on our configuration parameter
configure();
Startup();
}
sub GetContents
{
my $contents = shift;
mkdir("data");
my $fw = new FileHandle(">> data/log.txt");
print $fw $contents;
$fw->close;
}
sub Startup
{
get_options(@options, <<__USAGE__);
Try `$progname --help` to get a list of valid options.
__USAGE__
if(!(-f $strFilename))
{
exit 1;
}
while(1)
{
my $fr = new FileHandle($strFilename);
while(<$fr>)
{
chomp($_);
GetContents($_);
}
$fr->close;
Win32::Sleep($splicetime * 1000);
}
}
sub Install
{
get_options('name=s' => \$service, @options, <<__USAGE__);
Valid --install suboptions are:
auto automatically start service
--name service name [$service]
--fileName file name [$strFilename]
--Time time [$splicetime]
For example:
$progname --install auto --name TrackSvc --UrlList.txt --Time 120
__USAGE__
configure();
}
sub Remove {
get_options('name=s' => \$service, <<__USAGE__);
Valid --remove suboptions are:
--name service name [$service]
For example:
$progname --remove --name PingFoo
__USAGE__
# Let's be generous and support `PingSvc --remove PingFoo` too:
$service = shift @ARGV if @ARGV;
$Config{ServiceName} = $service;
}
sub Help
{
print <<__HELP__;
TrackSvc -- get html every $splicetime seconds and writedowntime in data
Run it interactivly with configurable FILENAME, LOGFILE and DELAY:
$progname --fileName FILENAME --Time SECONDS
or install it as a service:
$progname --install auto
net start $service
You can pause and resume the service with:
net pause $service
net continue $service
To remove the service from your system, stop und uninstall it:
net stop $service
$progname --remove
__HELP__
# Don't display standard PerlSvc help text
$Verbose = 0;
}
sub Pause {
}
sub Continue {
} |
|