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

[PerlMonk]

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

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

文件的建立：

• 模块：Win32
  Code: [show] | [select all]

  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: [show] | [select all]

  use Win32API::File qw(:ALL);
  
  use utf8;
  
  use Encode;
  
  $str="文tes?t.txt\x00";
  
  $hobject=CreateFileW(encode('UTF16-LE', $str), GENERIC_WRITE, 0, [], OPEN_ALWAYS,0,0);

目录的建立

• 模块：Win32
  Code: [show] | [select all]

  use Win32;
  
  use utf8;
  
  
  
  Win32::CreateDirectory("Dir?测试");

文件的枚举

• 在遇到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: [show] | [select all]

  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(/\x0d\x00\x0a\x00/, $all)) {
  
      $fn = encode('gbk', decode('utf16-le',$_))."\n";
  
      @xrr=split(/\x5c\x00/, $_);
  
      CopyFileW(
  
          $_ ."\x00",
  
          encode('utf-16le', decode('utf8', "$dst\\")).$xrr[$#xrr]."\x00",
  
          1
  
      );
  
      print "$^E\n" if ($^E);
  
  }
  
  <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: [show] | [select all]

  MoveFileW(
  
      encode('utf-16le', decode('utf8',$F))."\x00",
  
      encode('utf-16le', decode('utf8',$newname))."\x00"
  
      );

获取文件的日期信息：

• 普通文件名的情况
  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: [show] | [select all]

  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-$mday\n";
  
  <STDIN>;

[PerlMonk]

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

[523066680]

tigerpower 推荐了 Win32::Unicode

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

这里重新补充

http://bbs.bathome.net/redirect.php?got ... omuid=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]

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

GetFileAttributes 的返回值常量列表，可参考 MSDN 官方文档：
https://msdn.microsoft.com/en-us/librar ... s.85).aspx

Code: [show] | [select all]

use utf8;

use Encode;

use Win32API::File qw(:ALL);



my $path = "D:\\Extra\\中文";

my $code = GetFileAttributesW( encode('utf16-le', $path) ."\x00\x00"  );

if ( ($code & FILE_ATTRIBUTE_REPARSE_POINT) == FILE_ATTRIBUTE_REPARSE_POINT) 

{

    print "$code, symbolic link\n";

}

[523066680]

Code: [show] | [select all]

=info

    遍历目录树 支持 Unicode

    Code by 523066680@163.com

    2017-03

    

    V0.5 使用Win32API判断目录硬链接

=cut



use utf8;

use Encode;

use Win32API::File qw(GetFileAttributesW FILE_ATTRIBUTE_REPARSE_POINT);

use Win32::Unicode;

use IO::Handle;

STDOUT->autoflush(1);

binmode(STDOUT, ':encoding(gbk)');



our $n_files = 0;

our $n_dirs = 0;



my $path = "D:/Extra";

func($path, 0);



print $n_files ,"\n";

print $n_dirs;



sub func

{

    my ($path, $lv) = (shift, shift);

    my $wdir = Win32::Unicode::Dir->new;

    my $code;

    my $next_path;



    $wdir->open( $path );

    if ( $wdir->error() =~ /找不到/ )

    {

        print $wdir->error();

        exit;

    }



    while ( my $f = $wdir->read() )

    {

        if ( file_type('f', $path. "/" .$f ) )

        {

            print "    "x$lv . "$f\n";

            $n_files++;

        }



        next if ($f eq ".");

        next if ($f eq "..");



        $next_path = $path. "/" .$f;



        if ( file_type('d', $next_path ) )

        {

            $n_dirs++;

            print "    "x$lv . "$f\n";

            $code = GetFileAttributesW( encode('utf16-le', $next_path) ."\x00\x00" );



            if ( isLink( $code ) ) { print "skip symbolic link: $f\n"; }

            else                   { func( $next_path,  $lv+1 );       }

        }



    }

}



sub isLink 

{

    return ($_[0] & FILE_ATTRIBUTE_REPARSE_POINT) == FILE_ATTRIBUTE_REPARSE_POINT ? 

            1 : 0;

}