[Perl]Windows 系统 Unicode 文件名操作（新建、重命名、枚举、复制）全攻略

116 阅读 0 评论 77 点赞

我是靠谱客的博主自由发带，这篇文章主要介绍[Perl]Windows 系统 Unicode 文件名操作（新建、重命名、枚举、复制）全攻略，现在分享给大家，希望可以做个参考。

[Perl] Windows 系统 Unicode 文件名操作（新建、重命名、枚举、复制）全攻略

环境 XP/WIN7 Perl v5.16
编辑整理：PerlMonk、523066680

常见的那些文件操作函数都不支持，于是为了达到目的，需要各种方法配合，应该是不如其他语言方便。
我只是想看看Perl到底是否适合做这件事，于是折腾了一回。

文件的建立：

复制代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
模块：Win32
Code: [全选] [展开/收缩] [Download] (example.pl)
    use Win32;
    use utf8;
    use Encode;
     
    #接受unicode传参
    Win32::CreateFile("W32CreateFile・测试");
特性： 成功返回true，但不返回文件句柄
Creates the FILE and returns a true value on success.
Check $^E on failure for extended error information.

模块：Win32API::File
函数：$hObject= CreateFileW( $swPath, $uAccess, $uShare, $pSecAttr, $uCreate, $uFlags, $hModel )
$hObject可以返回文件对象句柄
注意事项： 传入的文件路径的编码格式为：UTF16-LE ，必须以x00结尾，示例(代码保存为utf8格式)：
Code: [全选] [展开/收缩] [Download] (example.pl)
    use Win32API::File qw(:ALL);
    use utf8;
    use Encode;
    $str="文tes・t.txtx00";
    $hobject=CreateFileW(encode('UTF16-LE', $str), GENERIC_WRITE, 0, [], OPEN_ALWAYS,0,0);

目录的建立

复制代码

1
2
3
4
5
6
模块：Win32
Code: [全选] [展开/收缩] [Download] (example.pl)
    use Win32;
    use utf8;
     
    Win32::CreateDirectory("Dir・测试");

文件的枚举

复制代码

1
2
3
4
5
在遇到unicode字符的时候，File::Find模块 以及 IO::Dir 模块都只能输出文件短名。
暂时用CMD /U Dir 的方法输出文件列表（郁闷吧，暂时没找到能完美操作的内置模块）
参考文章
http://www.perlmonks.org/?node_id=536223
how to read unicode filename

复制某个文件夹内的文件(文件名含unicode字符)

复制代码

模块：Win32API::File
如果先获取文件的短名，然后再复制，但是目标文件名也会变成短名。
于是暂时用cmd /U 模式获取文件列表，然后CopyFileW进行复制：
Code: [全选] [展开/收缩] [Download] (example.pl)
    use Win32API::File qw':ALL';
    use Encode;
    use utf8;
     
    my $src=encode('gbk','.\测试目录');
    my $dst='.\Target';
     
    #该目录只有一层，/s开关是为了列出完整的路径
    my $all=`cmd /U /C dir /s /b "$src"`;
    my $fn;
     
    foreach (split(/x0dx00x0ax00/, $all)) {
        $fn = encode('gbk', decode('utf16-le',$_))."n";
        @xrr=split(/x5cx00/, $_);
        CopyFileW(
            $_ ."x00",
            encode('utf-16le', decode('utf8', "$dst\")).$xrr[$#xrr]."x00",
            1
        );
        print "$^En" if ($^E);
    }
    <STDIN>;
细节一、
正确地使用 split $all 截断utf-16le字符段落，分隔符为0d 00 0a 00
参考枚举脚本

细节二、
如果用basename()分割路径，同样会遇到00被忽略的问题，'\' 的U16LE
编码是5C 00，但是basename 只按5C截断，剩下的00造成了处理乱码。

测试basename的第二个参数设置为 "x5cx00" 并不能解决这个问题
解决方法一、
手工去掉开头处00
方法二、
先转为GBK，再获取basename，再转utf-16le
2014-12-12 备注这种方法在LongPath的情况下，会丢失unicode字符
可以考虑转为UTF-8，不管怎么说都有点绕
方法三、
自己用正则表达式获取
/x5Cx00([^x5c]+)$/;
$1
方法四、
@xrr=split(/x5cx00/, $_);
$xrr[$#xrr]

细节三、
CopyFileW复制文件时，要在末尾加x00作为字符串终止符
否则各种问题=_=

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
模块：Win32API::File
如果先获取文件的短名，然后再复制，但是目标文件名也会变成短名。
于是暂时用cmd /U 模式获取文件列表，然后CopyFileW进行复制：
Code: [全选] [展开/收缩] [Download] (example.pl)
    use Win32API::File qw':ALL';
    use Encode;
    use utf8;
     
    my $src=encode('gbk','.\测试目录');
    my $dst='.\Target';
     
    #该目录只有一层，/s开关是为了列出完整的路径
    my $all=`cmd /U /C dir /s /b "$src"`;
    my $fn;
     
    foreach (split(/x0dx00x0ax00/, $all)) {
        $fn = encode('gbk', decode('utf16-le',$_))."n";
        @xrr=split(/x5cx00/, $_);
        CopyFileW(
            $_ ."x00",
            encode('utf-16le', decode('utf8', "$dst\")).$xrr[$#xrr]."x00",
            1
        );
        print "$^En" if ($^E);
    }
    <STDIN>;
细节一、
正确地使用 split $all 截断utf-16le字符段落，分隔符为0d 00 0a 00
参考枚举脚本

细节二、
如果用basename()分割路径，同样会遇到00被忽略的问题，'\' 的U16LE
编码是5C 00，但是basename 只按5C截断，剩下的00造成了处理乱码。

测试basename的第二个参数设置为 "x5cx00" 并不能解决这个问题
解决方法一、
手工去掉开头处00
方法二、
先转为GBK，再获取basename，再转utf-16le
2014-12-12 备注这种方法在LongPath的情况下，会丢失unicode字符
可以考虑转为UTF-8，不管怎么说都有点绕
方法三、
自己用正则表达式获取
/x5Cx00([^x5c]+)$/;
$1
方法四、
@xrr=split(/x5cx00/, $_);
$xrr[$#xrr]

细节三、
CopyFileW复制文件时，要在末尾加x00作为字符串终止符
否则各种问题=_=

判断文件是否存在：

复制代码

1
2
方法一：先转为短名再判断，不做赘述
方法二：渣方法，用CreateFileW测试建立同名文件，看是否有冲突

重命名：

复制代码

1
2
3
4
5
6
模块：Win32API::File
Code: [全选] [展开/收缩] [Download] (example.pl)
    MoveFileW(
        encode('utf-16le', decode('utf8',$F))."x00",
        encode('utf-16le', decode('utf8',$newname))."x00"
        );

获取文件的日期信息：

复制代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
普通文件名的情况
http://stackoverflow.com/questions/1839877/
how-can-i-get-a-files-modification-date-in-ddmmyy-format-in-perl

含有Unicode字符的文件名的情况
http://www.perlmonks.org/?node_id=741797
How to stat a file with a Unicode (UTF16-LE) filename in Windows?
其中的方法是通过createfileW 获取文件句柄，然后用OsFHandleOpen获取通用的文件句柄对象，并传入state
（感觉特别绕）

另一种就是先转为短名再获取日期，但是这种方法在处理文件量大的时候，效率非常低。前面perlmonks中的方法
效率要高得多
Code: [全选] [展开/收缩] [Download] (example.pl)
    use utf8;
    use Encode;
    use Win32;
     
    $filename='D:测试目录董贞 ・ 01.剑如虹.[贞江湖].mp3';
    $filename=Win32::GetShortPathName($filename);
     
    my $mtime = (stat $filename)[9];
    my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
    $year+=1900;
    $mon+=1;
    print "$year-$mon-$mdayn";
    <STDIN>;

=====================================================补充=========================================================
tigerpower 推荐了 Win32::Unicode

我以前执着于用自带的模块做文件系统的事情，现在想想真没必要，应该怎么方便怎么来。

这里重新补充

http://bbs.bathome.net/redirect.php?goto=findpost&ptid=34881&pid=168889&fromuid=3337

代码: 全选
use Win32::Unicode;
use utf8;
my $dirname="CreateDir・测试";
my $dirname_long="CreateDir・测试1/CreateDir・测试2/CreateDir・测试3";
my $dirname_new="CreateDir・测试・新";
my $filename="CreateFile・测试";

mkdirW $dirname;
chdirW $dirname;
mkpathW $dirname_long;
$fh = Win32::Unicode::File->new('>', $filename);
$fh->close;
chdirW $dirname_long;
touchW $filename.'1';
chdirW '../../../..';
cptreeW $dirname.'/',$dirname_new;

转载于:https://www.cnblogs.com/paktc/p/6855050.html