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

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
PerlMonk
渐入佳境
渐入佳境
帖子: 51
注册时间: 2016年09月19日 10:20
拥有现金: 锁定
Has thanked: 4 times
Been thanked: 3 times
联系:

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

帖子 #1 PerlMonk » 2016年10月06日 11:57

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

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

文件的建立:
    模块:Win32
    Code: [全选] [展开/收缩] [Download] (example.pl)
    1. use Win32;
    2. use utf8;
    3. use Encode;
    4.  
    5. #接受unicode传参
    6. 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)
    1. use Win32API::File qw(:ALL);
    2. use utf8;
    3. use Encode;
    4. $str="文tes・t.txt\x00";
    5. $hobject=CreateFileW(encode('UTF16-LE', $str), GENERIC_WRITE, 0, [], OPEN_ALWAYS,0,0);

目录的建立
文件的枚举
    在遇到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)
    1. use Win32API::File qw':ALL';
    2. use Encode;
    3. use utf8;
    4.  
    5. my $src=encode('gbk','.\\测试目录');
    6. my $dst='.\\Target';
    7.  
    8. #该目录只有一层,/s开关是为了列出完整的路径
    9. my $all=`cmd /U /C dir /s /b \"$src\"`;
    10. my $fn;
    11.  
    12. foreach (split(/\x0d\x00\x0a\x00/, $all)) {
    13.     $fn = encode('gbk', decode('utf16-le',$_))."\n";
    14.     @xrr=split(/\x5c\x00/, $_);
    15.     CopyFileW(
    16.         $_ ."\x00",
    17.         encode('utf-16le', decode('utf8', "$dst\\")).$xrr[$#xrr]."\x00",
    18.         1
    19.     );
    20.     print "$^E\n" if ($^E);
    21. }
    22. <STDIN>;
    细节一、
    正确地使用 split $all 截断utf-16le字符段落,分隔符为0d 00 0a 00
    参考枚举脚本

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

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

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

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

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

获取文件的日期信息:
    普通文件名的情况
    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)
    1. use utf8;
    2. use Encode;
    3. use Win32;
    4.  
    5. $filename='D:\测试目录\董贞 ・ 01.剑如虹.[贞江湖].mp3';
    6. $filename=Win32::GetShortPathName($filename);
    7.  
    8. my $mtime = (stat $filename)[9];
    9. my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
    10. $year+=1900;
    11. $mon+=1;
    12. print "$year-$mon-$mday\n";
    13. <STDIN>;
上次由 PerlMonk 在 2016年11月04日 14:12,总共编辑 1 次。

头像
PerlMonk
渐入佳境
渐入佳境
帖子: 51
注册时间: 2016年09月19日 10:20
拥有现金: 锁定
Has thanked: 4 times
Been thanked: 3 times
联系:

Re: [编码]Perl在遇到Unicode字符文件名时的各种处理方法

帖子 #2 PerlMonk » 2016年10月06日 11:59

最后总结,在经过各种折腾后,我觉得还是直接上C/C++实在

头像
523066680
Administrator
Administrator
帖子: 340
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 30 times
Been thanked: 27 times
联系:

Perl Win32 Unicode 文件名操作

帖子 #3 523066680 » 2017年03月12日 11:44

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;

头像
523066680
Administrator
Administrator
帖子: 340
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 30 times
Been thanked: 27 times
联系:

Win32API::File 判断文件/文件夹是否为符号链接

帖子 #4 523066680 » 2017年03月15日 11:06

Win32::Unicode 好像无法做这方面的判断,只能判断是否为目录、文件、文件是否存在。
Win32API::File 则支持 GetFileAttributesW

GetFileAttributes 的返回值常量列表,可参考 MSDN 官方文档:
https://msdn.microsoft.com/en-us/library/gg258117(v=vs.85).aspx
Code: [全选] [展开/收缩] [Download] (Untitled.pl)
  1. use utf8;
  2. use Encode;
  3. use Win32API::File qw(:ALL);
  4.  
  5. my $path = "D:\\Extra\\中文";
  6. my $code = GetFileAttributesW( encode('utf16-le', $path) ."\x00\x00"  );
  7. if ( ($code & FILE_ATTRIBUTE_REPARSE_POINT) == FILE_ATTRIBUTE_REPARSE_POINT)
  8. {
  9.     print "$code, symbolic link\n";
  10. }

头像
523066680
Administrator
Administrator
帖子: 340
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 30 times
Been thanked: 27 times
联系:

遍历目录树 - Unicode 模式

帖子 #5 523066680 » 2017年03月17日 10:20

Code: [全选] [展开/收缩] [Download] (Untitled.pl)
  1. =info
  2.     遍历目录树 支持 Unicode
  3.     Code by 523066680@163.com
  4.     2017-03
  5.    
  6.     V0.5 使用Win32API判断目录硬链接
  7. =cut
  8.  
  9. use utf8;
  10. use Encode;
  11. use Win32API::File qw(GetFileAttributesW FILE_ATTRIBUTE_REPARSE_POINT);
  12. use Win32::Unicode;
  13. use IO::Handle;
  14. STDOUT->autoflush(1);
  15. binmode(STDOUT, ':encoding(gbk)');
  16.  
  17. our $n_files = 0;
  18. our $n_dirs = 0;
  19.  
  20. my $path = "D:/Extra";
  21. func($path, 0);
  22.  
  23. print $n_files ,"\n";
  24. print $n_dirs;
  25.  
  26. sub func
  27. {
  28.     my ($path, $lv) = (shift, shift);
  29.     my $wdir = Win32::Unicode::Dir->new;
  30.     my $code;
  31.     my $next_path;
  32.  
  33.     $wdir->open( $path );
  34.     if ( $wdir->error() =~ /找不到/ )
  35.     {
  36.         print $wdir->error();
  37.         exit;
  38.     }
  39.  
  40.     while ( my $f = $wdir->read() )
  41.     {
  42.         if ( file_type('f', $path. "/" .$f ) )
  43.         {
  44.             print "    "x$lv . "$f\n";
  45.             $n_files++;
  46.         }
  47.  
  48.         next if ($f eq ".");
  49.         next if ($f eq "..");
  50.  
  51.         $next_path = $path. "/" .$f;
  52.  
  53.         if ( file_type('d', $next_path ) )
  54.         {
  55.             $n_dirs++;
  56.             print "    "x$lv . "$f\n";
  57.             $code = GetFileAttributesW( encode('utf16-le', $next_path) ."\x00\x00" );
  58.  
  59.             if ( isLink( $code ) ) { print "skip symbolic link: $f\n"; }
  60.             else                   { func( $next_path,  $lv+1 );       }
  61.         }
  62.  
  63.     }
  64. }
  65.  
  66. sub isLink
  67. {
  68.     return ($_[0] & FILE_ATTRIBUTE_REPARSE_POINT) == FILE_ATTRIBUTE_REPARSE_POINT ?
  69.             1 : 0;
  70. }


回到 “Perl”

在线用户

用户浏览此论坛: 没有注册用户 和 1 访客