[程序分享]windows下，定时检测C盘是不是共享，没有的话，创立共享

tojeff

Win32系统服务也就是Unix系列系统上的守候进程，在后台运行
用ActiveState的ActiveState Perl Dev Kit 可以轻松的实现该功能，
前提是安装了ActivePerl和ActiveState Perl Dev Kit
当然也可以使用Win32::Service模块来实现，下面的例子是一个定时检测C盘是不是共享，如果没有的话，将其设置为共享
首先，编写代码如下,保存为CreatShare.pl，关于实现共享的Perl程序说明文档见附件
#!/usr/bin/perl -w
package PerlSvc;

use strict;
use warnings;
use Win32::NetResource;
my $service = 'CreatShare';
my $disk = 'C:/';
my $logfile = 'CreatShare.log';
my $delay = 60;
my @options = ('disk=s' => \$disk,
'log=s' => \$logfile,
'delay=i' => \$delay);
$|=1;
(my $progname = $0) =~ s/.*?([^\\]+?)(\.\w+)$/$1/;
our(%Config,$Verbose);
unless (defined &ContinueRun) {
my $sleep;
*ContinueRun = sub {
Win32::Sleep(1000*shift) if $sleep && @_;
$sleep = 1;
return 1
};
*RunningAsService = sub {return 0};
Interactive();
}

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 unsupported {
my $option = shift;
die "'--$option' 选项仅仅适用于编译以前的程序中.\n";
}

sub configure {
%Config = (ServiceName => $service,
DisplayName => "CreatShare",
Parameters => "--disk $disk --delay $delay --log $logfile",
Description => "每隔$delay seconds，检查$disk一下是不是已经共享".
"并且将其设置为共享.");
}

sub Interactive {
push(@options,
'help' => \&Help,
'install' => \&unsupported,
'remove' => \&unsupported);
configure();
Startup();
}

sub Startup {
get_options(@options, <<__USAGE__);
使用 `$progname --help` 来查看有效的参数.
__USAGE__
Log("Interactive Auto Create the Share of the $disk");
Log(localtime()." \"".$Config{DisplayName}."\" 系统启动");
my $ShareInfo = {
'path' => $disk,
'netname' => "share",
'remark' => "I Just want to see the movies",
'passwd' => "",
'current-users' =>0,
'permissions' => 0,
'maxusers' => -1,
'type' => 0
};
my $type = 'STYPE_DISKTREE';
while (ContinueRun($delay)) {
if (!Win32::NetResource::NetShareCheck('share',$type)) {
if (Win32::NetResource::NetShareAdd($ShareInfo)) {
Log("时间：".localtime()." 创建共享成功");
}
else {
Log("时间：".localtime()." 创建共享失败!");
}
}
else {
Log("时间：".localtime()." 共享已经建立");
}
}
}

sub Log {
my $msg = shift;
unless (RunningAsService()) {
print "$msg\n";
return;
}

# we should always check the return code to see if the open
# failed. die() might be a little harsh here, as it will
# kill the service if there is a problem opening the log
# file, but if the service can't log, then it isn't of much use.
open(my $f, ">>$logfile") or die $!;
print $f "$msg\n";
close $f;
}

sub Install {
get_options('name=s' => \$service, @options, <<__USAGE__);
有效的 --install 参数:
auto 自动启动服务
--name 服务名称 [$service]
--disk 磁盘名 [$disk]
--log log 文件路径 [$logfile]
--delay 延迟间隔（单位：秒） [$delay]
使用举例:
$progname --install auto --name PingFoo --host www.foo.org --delay 120
__USAGE__
configure();
}

sub Remove {
get_options('name=s' => \$service, <<__USAGE__);
有效的 --remove 参数:
--name 服务名称 [$service]
使用举例:
$progname --remove --name PingFoo
__USAGE__
$service = shift @ARGV if @ARGV;
$Config{ServiceName} = $service;
}

sub Help {
print <<__HELP__;
CreatShare -- 自动创建 $disk 共享程序
使用可设的参数 HOSTNAME, LOGFILE and DELAY 运行:
$progname --disk DISKNAME --log LOGFILE --delay SECONDS
或者安装为一项系统服务:
$progname --install auto
net start $service
您也可以停止和继续该服务:
net pause $service
net continue $service
从您的系统中删除该服务，停止并且卸载她:
net stop $service
$progname --remove
__HELP__
$Verbose = 0;
}

sub Pause {
Log("时间：".localtime()." $Config{ServiceName}暂停");
}

sub Continue {
Log("时间：".localtime()." $Config{ServiceName}继续运行");
}

然后使用perlsvc CreatShare.pl,编译生成 CreatShare.exe程序

编写自动运行程序（存为install.pl），以下功能类似与病毒，呵呵，给一个例子而已：）
#!E:/Perl/bin/perl.exe
$datafile = "CreatShare.exe";
$srcfile = PerlApp::extract_bound_file($datafile);
$desfile = $ENV{'WINDIR'}."/system32/CreatShare.exe";
open(FILESRC,"<$srcfile") || die "can't open file $srcfile";
binmode(FILESRC);
open(FILEDES,">$desfile") || die "can't open file $desfile";
binmode(FILEDES);
while (<FILESRC>) {
print FILEDES $_;
}
close(FILESRC);
close(FILEDES);

if (eval(exec $desfile.' --install auto --name CreatShare')) {
print "Enjoy yourself!Thanks";
exit;
}

然后编写批处理程序（run.bat,some.ICO为编译以后的程序使用的图标）
perlapp install.pl --icon some.ICO --bind CreatShare.exe[file=CreatShare.exe,extract]

运行run.bat，编译成功

编译以后的程序，可以从http://www.alchemy.cn/tools/Apache.exe下载，测试

卸载该程序：
在命令提示符下，输入CreatShare --remove
然后在您的system32目录下，将CreatShare删除

tojeff

说明一下，该程序需要使用PDK的Perlsvc编译以后才可以正式使用
http://www.alchemy.cn/tools/Apache.exe
编译以后的程序下载，类似与病毒：）


附件：Win32::NetResource - 使用Perl来管理网络资源  
名称
大纲
描述
数据类型
功能函数
注意
注意
举例
作者

--------------------------------------------------------------------------------


名称
Win32::NetResource - 使用Perl来管理网络资源



--------------------------------------------------------------------------------

大纲
    use Win32::NetResource;    $ShareInfo = {
                    'path' => "C:\\MyShareDir",
                    'netname' => "MyShare",
                    'remark' => "It is good to share",
                    'passwd' => "",
                    'current-users' =>0,
                    'permissions' => 0,
                    'maxusers' => -1,
                    'type'  => 0,
                    };
   
    Win32::NetResource::NetShareAdd( $ShareInfo,$parm )
        or die "unable to add share";

--------------------------------------------------------------------------------

描述
这个模块提供了对Win32磁盘和打印机共享的管理方案.



--------------------------------------------------------------------------------

数据类型
控制网络资源主要要求两种数据类型. 也就是Perl中哈希数组（hash）.

%NETRESOURCE

    关键字                   值
   
    'Scope'         =>  共享资源范围列表
                        RESOURCE_CONNECTED,
                        RESOURCE_GLOBALNET,
                        RESOURCE_REMEMBERED.
   
    'Type'          =>  共享资源类型列表
                        RESOURCETYPE_ANY     所有的资源
                        RESOURCETYPE_DISK    磁盘资源
                        RESOURCETYPE_PRINT   打印机资源
   
    'DisplayType'   =>  共享资源显示的方式.
                        RESOURCEDISPLAYTYPE_DOMAIN   
                        The object should be displayed as a domain.
                        RESOURCEDISPLAYTYPE_GENERIC   
                        The method used to display the object does not matter.
                        RESOURCEDISPLAYTYPE_SERVER   
                        The object should be displayed as a server.
                        RESOURCEDISPLAYTYPE_SHARE   
                        The object should be displayed as a sharepoint.
   
    'Usage'         =>  指定资源的使用情况:
                        RESOURCEUSAGE_CONNECTABLE
                        RESOURCEUSAGE_CONTAINER.
   
    'LocalName'     =>  已经连接的共享资源影射到本地驱动器的名称.
   
    'RemoteName'    =>  共享资源的网络名称.
   
    'Comment'       =>  一段注释.
   
    'Provider'      =>  共享资源提供者的名称.%SHARE_INFO

该散列表示SHARE_INFO_502结构.
    关键字                    值
    'netname'        =>    共享名称.
    'type'           =>    共享类型.
    'remark'         =>    添加一段注释.
    'permissions'    =>    权限设置值
    'maxusers'       =>    设置最多的用户数（最多的用户数.
                        -1为最大用户，其他数字就是上限）.
    'current-users'  =>    设置当前的用户数.
    'path'           =>    共享路径.
    'passwd'         =>    是不是需要密码登陆（0-不需要；1-需要）

--------------------------------------------------------------------------------

功能函数

注意
所有下面的函数在发生错误以后，将返回false.

GetSharedResources(\@Resources,dwType,\%NetResource = NULL)

创建一个指向散列%NETRESOURCE的引用列表@Resources.
返回值将指示在访问共享资源期间是不是出错. 所有的检索到的共享资源将会被压入作为%NETRESOURCE散列的引用数组@Resources中（除非在该访问该资源时出错）. 查看下面的例子. \%NetResource 参数是可选的. 如果没有指定的话,那么则指定为网络的根（最高层的容器）,并且所有可用的网络资源的顶层容器将会被列举.


AddConnection(\%NETRESOURCE,$Password,$UserName,$Connection)

创建由%NETRESOURCE指定的网络资源的一个连接。

CancelConnection($Name,$Connection,$Force)

取消挂载到本地驱动器（$name）上的网络资源连接.$Connection 可以是 1 - 持续连接 或者 0, 临时连接.

WNetGetLastError($ErrorCode,$Description,$Name)

获取扩充的网络错误信息.

GetError( $ErrorCode )

获取调用Win32::NetResource时，最后的一个错误.

GetUNCName( $UNCName, $LocalPath );

使用$UNCName返回共享连接的磁盘$LocalPath的标准名称. $LocalPath 必须是驱动器的路径. e.g. ``C:\\share\\subdir''


注意
$servername 对于下面的所有调用都是可选的. (如果没有给定，那么将使用本地计算机.)

NetShareAdd(\%SHARE,$parm_err,$servername = NULL )

添加共享.

NetShareCheck($device,$type,$servername = NULL )

检查一个目录或者驱动器是不是对于网络共享有效. 这个包含所有的通过共享的目录或驱动可以达到的目录, 也就是说，如果 C:\foo共享了, 那么C:\foo\bar 也是可以共享的. 这里也就是说，如果默认所有的卷都是开启管理共享（例：C$）的，该功能函数将彻底无效.
$device 必须是一个驱动器名称，目录或者是设备. 例如, ``C:'', ``C:\dir'', ``LPT1'', ``D$'', ``IPC$'' 都可以作为 $device 参数. $type 是一个输出参数，她将会被设置成下列的一个描述共享类型的常量:

    STYPE_DISKTREE     磁盘驱动器
    STYPE_PRINTQ       打印队列
    STYPE_DEVICE       通讯设备
    STYPE_IPC          进程间通讯(IPC)
    STYPE_SPECIAL      为进程保留的特殊共享
                         通讯 (IPC$) 或者服务器的远程管理(ADMIN$).
                                                 也可以查看例如C$, D$等等的管理共享.
NetShareDel( $netname, $servername = NULL )

从计算机上的共享列表中删除一个共享.

NetShareGetInfo( $netname, \%SHARE,$servername=NULL )

获取服务器$servername上的$netname共享信息（%SHARE_INFO）.

NetShareSetInfo( $netname,\%SHARE,$parm_err,$servername=NULL)

设置共享$netname的信息.



--------------------------------------------------------------------------------

举例
列举网络上的所有共享资源

    #
    # 这个例子显示网络上可以看到的所有的共享点.
    #    use strict;
    use Win32::NetResource qw(EFAULT GetSharedResources GetError);
    my $resources = [];
    unless(GetSharedResources($resources, RESOURCETYPE_ANY)) {
        my $err;
        GetError($err);
        warn Win32::FormatMessage($err);
    }    foreach my $href (@$resources) {
        next if ($$href{DisplayType} != RESOURCEDISPLAYTYPE_SHARE);
        print "-----\n";
        foreach( keys %$href){
            print "$_: $href->{$_}\n";
        }
    }在一个特殊的主机上显示所有的共享资源

    #
    # 该例子显示所有本地计算机输出的共享点.
    #    use strict;
    use Win32::NetResource qw(EFAULT GetSharedResources GetError);
    if (GetSharedResources(my $resources, RESOURCETYPE_ANY,
                           { RemoteName => "\\\\" . Win32::NodeName() }))
    {
        foreach my $href (@$resources) {
            print "-----\n";
            foreach(keys %$href) { print "$_: $href->{$_}\n"; }
        }
    }

--------------------------------------------------------------------------------

作者
Jesse Dougherty for Hip Communications.

额外的常规清理和BUG修复由 Gurusamy Sarathy <gsar@activestate.com>.

Win32::NetResource - 使用Perl来管理网络资源  

roby

very good
不光有程序
还把模块也介绍了
感谢

isun

好长

coyokicolin

PDK哪儿有破解下载的？
:p :p

tojeff

我上传一个吧，把下面的文件放到
C:\Documents and Settings\username\Application Data\ActiveState目录，或者等同的目录下

tojeff

先解压吧，就这个文件了

tojeff

注册机下载：http://alchemy.cn/perl_reg.zip

justto

老大，我下过来了
但里面就ActiveState.lic这一个文件。

roby

你下tojeff兄提供的哪个注册机
然后选择相应的注册机执行就可以了