免费注册 查看新帖 |

Chinaunix

  平台 论坛 博客 文库
最近访问板块 发新帖
查看: 3370 | 回复: 4

向高手求助! PerlSvc包使用问题! [复制链接]

论坛徽章:
0
发表于 2005-10-12 22:28 |显示全部楼层
我写了一段代码,使用perlsvc编译后,运行时服务可以正常注册、卸载,但不能“启动”。启动时报错“xxxxxx failed to start” ,我使用 --debug 跟踪调试 ,未发现错误,但就是启动失败

代码主要内容如下: 请指教!(刚才忘了说明 需要在.exe 的同级目录下放一个urllist.txt文件,该文件一行为一个词)



  1. package PerlSvc;
  2. use strict;
  3. use warnings;
  4. use FileHandle;

  5. $" = "-";
  6. $|=1;
  7. my $strFilename = "UrlList.txt";
  8. my $splicetime = 60 * 15;
  9. my $service = "TrackSvc";
  10. my @options = ('fileName' =>; \$strFilename,
  11.         'Time' =>; \$splicetime);

  12. (my $progname = $0) =~ s/.*?([^\\]+?)(\.\w+)$/$1/;
  13. our(%Config,$Verbose);

  14. unless (defined &ContinueRun) {
  15.   # Don't delay the very first time ContinueRun() is called
  16.   my $sleep;
  17.   *ContinueRun = sub {
  18.      Win32::Sleep(1000*shift) if $sleep && @_;
  19.      $sleep = 1;
  20.      return 1
  21.   };
  22.   *RunningAsService = sub {return 0};
  23.   # Interactive() would be called automatically if we were running
  24.   # the compiled PingSvc.exe
  25.   Interactive();
  26. }
  27. sub unsupported {
  28.   my $option = shift;
  29.   die "The '--$option' option is only supported in the compiled script.\n";
  30. }
  31. sub get_options {
  32.   require Getopt::Long;
  33.   my @options = @_;
  34.   my $usage = pop @options;
  35.   $SIG{__WARN__} = sub { print "$usage\n$_[0]"; exit 1 };
  36.   Getopt::Long::GetOptions(@options);
  37.   $SIG{__WARN__} = 'DEFAULT';
  38. }

  39. sub configure {
  40.   %Config = (ServiceName =>; $service,
  41.          DisplayName =>; "GetHtml $service",
  42.          Parameters =>; "--fileName $strFilename --Time $splicetime",
  43.          Description =>; "Get Html"
  44.                 );

  45. }

  46. sub Interactive {
  47.   # These entries are only used when the program is run with
  48.   # `perl PingSvc.pl` and is not compiled into a service yet.
  49.   push(@options,
  50.       'help'  =>; \&Help,
  51.       'install' =>; \&unsupported,
  52.       'remove' =>; \&unsupported);

  53.   # Setup the %Config hash based on our configuration parameter
  54.   configure();
  55.   Startup();
  56. }
  57. sub GetContents
  58. {  
  59.     my $contents = shift;
  60.     mkdir("data");
  61.     my $fw = new FileHandle(">;>; data/log.txt");
  62.     print $fw $contents;
  63.     $fw->;close;
  64.   
  65. }
  66. sub Startup
  67. {
  68.   get_options(@options, <<__USAGE__);
  69. Try `$progname --help` to get a list of valid options.
  70. __USAGE__


  71.   if(!(-f $strFilename))
  72.   {
  73.     exit 1;
  74.   }
  75.   while(1)
  76.   {
  77.     my $fr = new FileHandle($strFilename);
  78.     while(<$fr>;)
  79.     {
  80.       chomp($_);
  81.       GetContents($_);  
  82.     }
  83.     $fr->;close;
  84.     Win32::Sleep($splicetime * 1000);
  85.   }
  86.   
  87. }

  88. sub Install
  89. {
  90.   get_options('name=s' =>; \$service, @options, <<__USAGE__);
  91. Valid --install suboptions are:

  92. auto    automatically start service
  93. --name   service name           [$service]
  94. --fileName   file name            [$strFilename]
  95. --Time   time          [$splicetime]

  96. For example:

  97. $progname --install auto --name TrackSvc --UrlList.txt --Time 120

  98. __USAGE__
  99.   configure();

  100. }

  101. sub Remove {
  102.   get_options('name=s' =>; \$service, <<__USAGE__);
  103. Valid --remove suboptions are:

  104. --name   service name           [$service]

  105. For example:

  106. $progname --remove --name PingFoo
  107. __USAGE__

  108.   # Let's be generous and support `PingSvc --remove PingFoo` too:
  109.   $service = shift @ARGV if @ARGV;

  110.   $Config{ServiceName} = $service;
  111. }

  112. sub Help
  113. {
  114.   print <<__HELP__;
  115. TrackSvc -- get html every $splicetime seconds and writedowntime in data

  116. Run it interactivly with configurable FILENAME, LOGFILE and DELAY:

  117.   $progname --fileName FILENAME --Time SECONDS

  118. or install it as a service:

  119.   $progname --install auto
  120.   net start $service

  121. You can pause and resume the service with:

  122.   net pause $service
  123.   net continue $service

  124. To remove the service from your system, stop und uninstall it:

  125.   net stop $service
  126.   $progname --remove
  127. __HELP__

  128.   # Don't display standard PerlSvc help text
  129.   $Verbose = 0;
  130. }

  131. sub Pause {
  132.   
  133. }

  134. sub Continue {
  135.   
  136. }

复制代码

论坛徽章:
0
发表于 2005-10-14 20:50 |显示全部楼层

向高手求助! PerlSvc包使用问题!

偶仔细看了,但也8明白...可能你使用的包有点特殊...

论坛徽章:
0
发表于 2008-03-22 14:24 |显示全部楼层
把這個重寫吧,


以下是注冊成系統服務的代碼,
#2009/1/1 下午 04:41:51 台北標準時間

#                                               

# :TODO:2009/1/1::

#using "CreateService" API to Create a Win32 Service

#AUTHOR: Baggio, 郭樂聰


use Win32::API;

my $SvcName = Resident;
my $SvcDisplayName = Run;
my $path = $0;
$path =~ s/\\/\//g;


my $OpenSCManager = new Win32::API("advapi32","OpenSCManager",["P", "N", "N"],"N");
my $CreateService = new Win32::API('advapi32','CreateService',["N","P","P","N","N","N","N","P","P","N","P","N","N"],"N");
#my $GetLastError = new Win32::API("kernel32","GetLastError",'',N);


my $hSCM = $OpenSCManager->Call(
&nbsp;&nbsp;&nbsp;&nbsp;undef,
&nbsp;&nbsp;&nbsp;&nbsp;undef,
&nbsp;&nbsp;&nbsp;&nbsp;0x00000002
);

#print $hSCM,"\n";

$hSC = $CreateService->Call(
&nbsp;&nbsp;&nbsp;&nbsp;$hSCM,
&nbsp;&nbsp;&nbsp;&nbsp;$SvcName,
&nbsp;&nbsp;&nbsp;&nbsp;$SvcDisplayName,
&nbsp;&nbsp;&nbsp;&nbsp;0x00000000,
&nbsp;&nbsp;&nbsp;&nbsp;0x00000010,
&nbsp;&nbsp;&nbsp;&nbsp;0x00000002,
&nbsp;&nbsp;&nbsp;&nbsp;0x00000001,
&nbsp;&nbsp;&nbsp;&nbsp;$path,
&nbsp;&nbsp;&nbsp;&nbsp;undef,
&nbsp;&nbsp;&nbsp;&nbsp;undef,
&nbsp;&nbsp;&nbsp;&nbsp;undef,
&nbsp;&nbsp;&nbsp;&nbsp;0,
&nbsp;&nbsp;&nbsp;&nbsp;0,
);


HTH
遲些我會把這個寫成模組,
網上竟然找不到用Win32::API模組調用CreateService的例子,
只好自已寫一個了.

[ 本帖最后由 lokchungk 于 2009-1-1 16:54 编辑 ]

论坛徽章:
0
发表于 2009-01-01 16:54 |显示全部楼层
用了上面的代碼後,
要用Win32::Service來StartService,


順便一問CU各高手,
請問如何安裝Win32-Daemon?
OS: Windows XP SP3
Perl Version: 5.10.0 build 1004
我裝了半天也裝不到
貌似那邊Server有問題...

论坛徽章:
0
发表于 2009-01-03 13:48 |显示全部楼层
原帖由 lokchungk 于 2009-1-1 16:54 发表
順便一問CU各高手,
請問如何安裝Win32-Daemon?
OS: Windows XP SP3
Perl Version: 5.10.0 build 1004
我裝了半天也裝不到
貌似那邊Server有問題...



那用perl5.8.8 试试先,然后ppml install http://www.roth.net/perl/packages/win32-daemon.ppd
最后把代码封装编译后仍到2000/xp/2003下跑 我就是这样做的 现在在服务器上跑了半年咯都OK :)
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

SACC2021中国系统架构师大会

【数字转型 架构重塑】
2022年1月13-15日,由IT168旗下ITPUB企业社区平台主办的第十四届中国系统架构师大会(SACC2021)将在云端进行网络直播。
为期3天的议程,涉及20+专场,近120个主题,完整迁移到线上进行网络直播对会议组织来说绝非易事;但考虑到云端会议的直播形式可以实现全国各地技术爱好者的参与,也使ITPUB作为技术共享交流平台得到更好的普及,我们决定迎难而上。

大会官网
  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122 niuxiaotong@pcpop.com 17352615567
未成年举报专区
中国互联网协会会员  联系我们:huangweiwei@itpub.net
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP