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

djw_posion

我写了一段代码，使用perlsvc编译后，运行时服务可以正常注册、卸载，但不能“启动”。启动时报错“xxxxxx failed to start” ，我使用 --debug 跟踪调试 ，未发现错误，但就是启动失败

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

1. 
   
2. 
   
3. package PerlSvc;
   
4. use strict;
   
5. use warnings;
   
6. use FileHandle;
   
7. 
   
8. $" = "-";
   
9. $|=1;
   
10. my $strFilename = "UrlList.txt";
    
11. my $splicetime = 60 * 15;
    
12. my $service = "TrackSvc";
    
13. my @options = ('fileName' =>; \$strFilename,
    
14.         'Time' =>; \$splicetime);
    
15. 
    
16. (my $progname = $0) =~ s/.*?([^\\]+?)(\.\w+)$/$1/;
    
17. our(%Config,$Verbose);
    
18. 
    
19. unless (defined &ContinueRun) {
    
20.   # Don't delay the very first time ContinueRun() is called
    
21.   my $sleep;
    
22.   *ContinueRun = sub {
    
23.      Win32::Sleep(1000*shift) if $sleep && @_;
    
24.      $sleep = 1;
    
25.      return 1
    
26.   };
    
27.   *RunningAsService = sub {return 0};
    
28.   # Interactive() would be called automatically if we were running
    
29.   # the compiled PingSvc.exe
    
30.   Interactive();
    
31. }
    
32. sub unsupported {
    
33.   my $option = shift;
    
34.   die "The '--$option' option is only supported in the compiled script.\n";
    
35. }
    
36. sub get_options {
    
37.   require Getopt::Long;
    
38.   my @options = @_;
    
39.   my $usage = pop @options;
    
40.   $SIG{__WARN__} = sub { print "$usage\n$_[0]"; exit 1 };
    
41.   Getopt::Long::GetOptions(@options);
    
42.   $SIG{__WARN__} = 'DEFAULT';
    
43. }
    
44. 
    
45. sub configure {
    
46.   %Config = (ServiceName =>; $service,
    
47.          DisplayName =>; "GetHtml $service",
    
48.          Parameters =>; "--fileName $strFilename --Time $splicetime",
    
49.          Description =>; "Get Html"
    
50.                 );
    
51. 
    
52. }
    
53. 
    
54. sub Interactive {
    
55.   # These entries are only used when the program is run with
    
56.   # `perl PingSvc.pl` and is not compiled into a service yet.
    
57.   push(@options,
    
58.       'help'  =>; \&Help,
    
59.       'install' =>; \&unsupported,
    
60.       'remove' =>; \&unsupported);
    
61. 
    
62.   # Setup the %Config hash based on our configuration parameter
    
63.   configure();
    
64.   Startup();
    
65. }
    
66. sub GetContents
    
67. {  
    
68.     my $contents = shift;
    
69.     mkdir("data");
    
70.     my $fw = new FileHandle(">;>; data/log.txt");
    
71.     print $fw $contents;
    
72.     $fw->;close;
    
73.   
    
74. }
    
75. sub Startup
    
76. {
    
77.   get_options(@options, <<__USAGE__);
    
78. Try `$progname --help` to get a list of valid options.
    
79. __USAGE__
    
80. 
    
81. 
    
82.   if(!(-f $strFilename))
    
83.   {
    
84.     exit 1;
    
85.   }
    
86.   while(1)
    
87.   {
    
88.     my $fr = new FileHandle($strFilename);
    
89.     while(<$fr>;)
    
90.     {
    
91.       chomp($_);
    
92.       GetContents($_);  
    
93.     }
    
94.     $fr->;close;
    
95.     Win32::Sleep($splicetime * 1000);
    
96.   }
    
97.   
    
98. }
    
99. 
    
100. sub Install
     
101. {
     
102.   get_options('name=s' =>; \$service, @options, <<__USAGE__);
     
103. Valid --install suboptions are:
     
104. 
     
105. auto    automatically start service
     
106. --name   service name           [$service]
     
107. --fileName   file name            [$strFilename]
     
108. --Time   time          [$splicetime]
     
109. 
     
110. For example:
     
111. 
     
112. $progname --install auto --name TrackSvc --UrlList.txt --Time 120
     
113. 
     
114. __USAGE__
     
115.   configure();
     
116. 
     
117. }
     
118. 
     
119. sub Remove {
     
120.   get_options('name=s' =>; \$service, <<__USAGE__);
     
121. Valid --remove suboptions are:
     
122. 
     
123. --name   service name           [$service]
     
124. 
     
125. For example:
     
126. 
     
127. $progname --remove --name PingFoo
     
128. __USAGE__
     
129. 
     
130.   # Let's be generous and support `PingSvc --remove PingFoo` too:
     
131.   $service = shift @ARGV if @ARGV;
     
132. 
     
133.   $Config{ServiceName} = $service;
     
134. }
     
135. 
     
136. sub Help
     
137. {
     
138.   print <<__HELP__;
     
139. TrackSvc -- get html every $splicetime seconds and writedowntime in data
     
140. 
     
141. Run it interactivly with configurable FILENAME, LOGFILE and DELAY:
     
142. 
     
143.   $progname --fileName FILENAME --Time SECONDS
     
144. 
     
145. or install it as a service:
     
146. 
     
147.   $progname --install auto
     
148.   net start $service
     
149. 
     
150. You can pause and resume the service with:
     
151. 
     
152.   net pause $service
     
153.   net continue $service
     
154. 
     
155. To remove the service from your system, stop und uninstall it:
     
156. 
     
157.   net stop $service
     
158.   $progname --remove
     
159. __HELP__
     
160. 
     
161.   # Don't display standard PerlSvc help text
     
162.   $Verbose = 0;
     
163. }
     
164. 
     
165. sub Pause {
     
166.   
     
167. }
     
168. 
     
169. sub Continue {
     
170.   
     
171. }
     
172. 
     

复制代码

兰花仙子

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

lokchungk

把這個重寫吧,


以下是注冊成系統服務的代碼,

#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(     undef,     undef,     0x00000002 ); #print $hSCM,"\n"; $hSC = $CreateService->Call(     $hSCM,     $SvcName,     $SvcDisplayName,     0x00000000,     0x00000010,     0x00000002,     0x00000001,     $path,     undef,     undef,     undef,     0,     0, );

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

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

lokchungk

用了上面的代碼後,
要用Win32::Service來StartService,


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

xuanfei

原帖由 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 ：）