[Perl]Windows 系統 Unicode 文件名操做（新建、重命名、枚舉、複製）全攻略

[Perl] Windows 系統 Unicode 文件名操做（新建、重命名、枚舉、複製）全攻略

環境 XP/WIN7 Perl v5.16
編輯整理：PerlMonk、523066680

常見的那些文件操做函數都不支持，因而爲了達到目的，須要各類方法配合，應該是不如其餘語言方便。
我只是想看看Perl究竟是否適合作這件事，因而折騰了一回。

文件的創建：

模塊：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.txt\x00";
    $hobject=CreateFileW(encode('UTF16-LE', $str), GENERIC_WRITE, 0, [], OPEN_ALWAYS,0,0);

目錄的創建

模塊：Win32
Code: [全選] [展開/收縮] [Download] (example.pl)
    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: [全選] [展開/收縮] [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(/\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>;
細節1、
正確地使用 split $all 截斷utf-16le字符段落，分隔符爲0d 00 0a 00
參考枚舉腳本

細節2、
若是用basename()分割路徑，一樣會遇到00被忽略的問題，'\\' 的U16LE
編碼是5C 00，可是basename 只按5C截斷，剩下的00形成了處理亂碼。

測試basename的第二個參數設置爲 "\x5c\x00" 並不能解決這個問題
解決方法1、
手工去掉開頭處00
方法2、
先轉爲GBK，再獲取basename，再轉utf-16le
2014-12-12 備註這種方法在LongPath的狀況下，會丟失unicode字符
能夠考慮轉爲UTF-8，無論怎麼說都有點繞
方法3、
本身用正則表達式獲取
/\x5C\x00([^\x5c]+)$/;
$1
方法4、
@xrr=split(/\x5c\x00/, $_);
$xrr[$#xrr]

細節3、
CopyFileW複製文件時，要在末尾加\x00做爲字符串終止符
不然各類問題=_=

判斷文件是否存在：

方法一：先轉爲短名再判斷，不作贅述
方法二：渣方法，用CreateFileW測試創建同名文件，看是否有衝突

重命名：

模塊：Win32API::File
Code: [全選] [展開/收縮] [Download] (example.pl)
    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: [全選] [展開/收縮] [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-$mday\n";
    <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;