免費注冊 查看新帖 |

Chinaunix

  平臺 論壇 博客 文庫
12下一頁
最近訪問板塊 發新帖
查看: 85850 | 回復: 14
打印 上一主題 下一主題

[Perl] Windows 系統 Unicode 文件名操作(新建、重命名、枚舉、復制)全攻略 [復制鏈接]

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
跳轉到指定樓層
1 [收藏(0)] [報告]
發表于 2017-05-16 14:58 |只看該作者 |倒序瀏覽
本帖最后由 523066680 于 2017-09-21 16:45 編輯

環境 XP/WIN7 Active Perl v5.16
編輯整理:523066680
原帖:http://code-by.org/viewtopic.php?f=17&t=131
專欄:https://zhuanlan.zhihu.com/PerlExample

以下主要討論用 ActivePerl 自帶的模塊的處理方法,更省心的辦法請參考2樓
由于常見的那些文件操作函數都不支持,為了達到目的,需要各種方法配合。
以下腳本代碼均保存為 utf8 編碼格式。

文件的建立



    模塊: WIN32



        use Win32;
        use utf8;

        #接受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結尾。
      示例代碼:


        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



        use Win32;
        use utf8;

        Win32::CreateDirectory("Dir・測試");

枚舉文件


    在遇到unicode字符的時候,File::Find模塊 以及 IO::Dir 模塊都只能輸出文件短名。
    但是可以通過 `CMD /U Dir /s /b` 的方式獲取,/U參數允許命令行以Unicode形式輸出。
    參考文章
    [how to read unicode filename](http://www.perlmonks.org/?node_id=536223)

復制某個文件夾內的文件



    模塊:Win32API::File


      如果先獲取文件的短名,然后再復制,目標文件名也會變成短名。
      可先用 cmd /U 模式獲取文件列表,然后CopyFileW進行復制:


        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;

        for (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);
        }

    這里有幾個注意事項



    細節一、


      正確地使用 split $all 截斷utf-16le字符段落,分隔符應為0d 00 0a 00

    細節二、


      如果用 basename() 分割路徑,同樣會遇到00被忽略的問題,'\\' 的U16LE
      編碼是5C 00,但是basename 只按5C截斷,剩下的00造成了處理亂碼。

      測試basename的第二個參數設置為 "\x5c\x00" 并不能解決這個問題

      解決方法


        手工去掉開頭處的 \x00
        或者:
        @xrr=split(/\x5c\x00/, $_);

    細節三、


      CopyFileW復制文件時,要在末尾加\x00作為字符串終止符,否則各種問題=_=

判斷文件是否存在


    方法一:先轉為短名再判斷,不做贅述
    方法二:渣方法,用CreateFileW測試建立同名文件,看是否有沖突

重命名



    模塊:Win32API::File



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

獲取文件的日期信息



    普通文件名的情況含有Unicode字符的文件名的情況


      [How to stat a file with a Unicode (UTF16-LE) filename in Windows?](fhttp://www.perlmonks.org/?node_id=741797)

      其中的方法是通過createfileW 獲取文件句柄,然后用OsFHandleOpen獲取通用的文件句柄對象,并傳入state
      (感覺特別繞)

      另一種就是先轉為短名再獲取日期,但是這種方法在處理文件量大的時候,效率非常低。
      前面 perlmonks 中的方法效率要高得多


        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";

[Finished in 0.4s]

評分

參與人數 3可用積分 +10 信譽積分 +120 收起 理由
flw + 10 + 100 贊一個!
rubyish + 10 3 Q ~~ , very good!
hztj2005 + 10 贊一個!

查看全部評分

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
2 [報告]
發表于 2017-05-16 15:07 |只看該作者
本帖最后由 523066680 于 2017-05-16 17:48 編輯

我在 Bathome 發這個帖子的時候 tigerpower 推薦了 Win32::Unicode,不知道什么原因他自己又刪了帖
這里再推薦一下(以下腳本用 UTF8 編碼格式保存):
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;



評分

參與人數 1信譽積分 +10 收起 理由
rubyish + 10 3 Q ~ ~

查看全部評分

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
3 [報告]
發表于 2017-05-16 15:11 |只看該作者

Win32API::File 判斷文件/文件夾是否為符號鏈接

本帖最后由 523066680 于 2017-05-16 15:25 編輯

單單 Win32::Unicode 還是不夠的,如果要遞歸遍歷目錄樹,目錄名含有 Unicode 字符,且含有硬鏈接(鏈接指向父文件夾自身)的情況下,
程序會陷入無限遞歸。

所以還需要借用 Win32API::File 的 GetFileAttributesW

GetFileAttributes 的返回值常量列表,可參考 MSDN 官方文檔:
https://msdn.microsoft.com/en-us/library/gg258117(v=vs.85).aspx


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";
}


原帖:http://code-by.org/viewtopic.php?f=17&t=131

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
4 [報告]
發表于 2017-05-16 15:11 |只看該作者

遞歸窮舉目錄樹 (支持Unicode目錄、文件名)

本帖最后由 523066680 于 2017-05-16 17:47 編輯

=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;
}

論壇徽章:
6
數據庫技術版塊每日發帖之星
日期:2015-11-27 06:20:00程序設計版塊每日發帖之星
日期:2015-12-01 06:20:00每日論壇發貼之星
日期:2015-12-01 06:20:0015-16賽季CBA聯賽之佛山
日期:2017-03-26 23:38:0315-16賽季CBA聯賽之江蘇
日期:2017-07-17 10:08:4415-16賽季CBA聯賽之北京
日期:2018-03-04 17:01:50
5 [報告]
發表于 2017-05-16 16:45 |只看該作者
從技術層面來講贊一個!
的確是

論壇徽章:
307
程序設計版塊每周發帖之星
日期:2016-04-08 00:41:33操作系統版塊每日發帖之星
日期:2015-09-02 06:20:00每日論壇發貼之星
日期:2015-09-02 06:20:00程序設計版塊每日發帖之星
日期:2015-09-04 06:20:00每日論壇發貼之星
日期:2015-09-04 06:20:00每周論壇發貼之星
日期:2015-09-06 22:22:00程序設計版塊每日發帖之星
日期:2015-09-09 06:20:00程序設計版塊每日發帖之星
日期:2015-09-19 06:20:00程序設計版塊每日發帖之星
日期:2015-09-20 06:20:00每日論壇發貼之星
日期:2015-09-20 06:20:00程序設計版塊每日發帖之星
日期:2015-09-22 06:20:00程序設計版塊每日發帖之星
日期:2015-09-24 06:20:00
6 [報告]
發表于 2017-05-16 17:58 |只看該作者
如果您還在的話,可否試下?
badName.rar (11.28 KB, 下載次數: 0)

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
7 [報告]
發表于 2017-05-16 18:09 |只看該作者
本帖最后由 523066680 于 2017-05-16 18:13 編輯

回復 6# sunzhiguolu

我覺得CU的經營可能有點問題,

下載附件 -> 需要掃描二維碼關注CU公眾號 -> 發送 Download 返回驗證碼

然后返回驗證碼輸入后提示:
抱歉,該附件無法讀取


然后發帖也是,發鏈接會自動取消 url 效果,給鏈接加標題反而會使鏈接不顯示。
CU的管理層,心胸是多么狹隘。


論壇徽章:
307
程序設計版塊每周發帖之星
日期:2016-04-08 00:41:33操作系統版塊每日發帖之星
日期:2015-09-02 06:20:00每日論壇發貼之星
日期:2015-09-02 06:20:00程序設計版塊每日發帖之星
日期:2015-09-04 06:20:00每日論壇發貼之星
日期:2015-09-04 06:20:00每周論壇發貼之星
日期:2015-09-06 22:22:00程序設計版塊每日發帖之星
日期:2015-09-09 06:20:00程序設計版塊每日發帖之星
日期:2015-09-19 06:20:00程序設計版塊每日發帖之星
日期:2015-09-20 06:20:00每日論壇發貼之星
日期:2015-09-20 06:20:00程序設計版塊每日發帖之星
日期:2015-09-22 06:20:00程序設計版塊每日發帖之星
日期:2015-09-24 06:20:00
8 [報告]
發表于 2017-05-16 18:16 |只看該作者
本帖最后由 sunzhiguolu 于 2017-05-16 18:22 編輯

回復 7# 523066680
度娘分享

如果不行,我再換種方式將文件發出來。

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
9 [報告]
發表于 2017-05-16 19:02 |只看該作者
本帖最后由 523066680 于 2017-05-16 19:05 編輯

回復 8# sunzhiguolu

use Encode;
my $s = `cmd /U /c dir /b *.htm`;
$s=~s/\x0d\x00\x0a\x00$//;
print encode('gbk', decode('utf16le', $s)) ,"\n";

use Win32API::File qw/:ALL/;
my $hObject = CreateFileW( $s, GENERIC_READ, 0, [], OPEN_ALWAYS,0,0);
OsFHandleOpen(FILE, $hObject, "r") or warn "$!";

for ( 1 .. 10 )
{
    print encode('gbk', (decode('utf8', <FILE>)));
}

CloseHandle $hObject;
close FILE;


顯示文件名(轉gbk當然會有丟失,在程序變量中仍是完整的),讀取前10行內容并輸出

Marília Mendon?a - Eu Sei De Cor by WSOUNDS_ Sertanejo ? _ Free Listening on SoundCloud.htm
<!DOCTYPE html>

<html lang="en">
<head>
  <meta charset="utf-8">
  
  <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1">

  
  <link rel="dns-prefetch" href="//style.sndcdn.com">


論壇徽章:
307
程序設計版塊每周發帖之星
日期:2016-04-08 00:41:33操作系統版塊每日發帖之星
日期:2015-09-02 06:20:00每日論壇發貼之星
日期:2015-09-02 06:20:00程序設計版塊每日發帖之星
日期:2015-09-04 06:20:00每日論壇發貼之星
日期:2015-09-04 06:20:00每周論壇發貼之星
日期:2015-09-06 22:22:00程序設計版塊每日發帖之星
日期:2015-09-09 06:20:00程序設計版塊每日發帖之星
日期:2015-09-19 06:20:00程序設計版塊每日發帖之星
日期:2015-09-20 06:20:00每日論壇發貼之星
日期:2015-09-20 06:20:00程序設計版塊每日發帖之星
日期:2015-09-22 06:20:00程序設計版塊每日發帖之星
日期:2015-09-24 06:20:00
10 [報告]
發表于 2017-05-16 19:09 |只看該作者
版主,牛X 的帖子趕快加精華。
另外, 把我那篇加精華的帖子隨便找個各方丟了吧。哈哈哈,服了。。。
您需要登錄后才可以回帖 登錄 | 注冊

本版積分規則 發表回復

  

北京盛拓優訊信息技術有限公司. 版權所有 京ICP備16024965號-6 北京市公安局海淀分局網監中心備案編號:11010802020122 niuxiaotong@pcpop.com 17352615567
未成年舉報專區
中國互聯網協會會員  聯系我們:huangweiwei@itpub.net
感謝所有關心和支持過ChinaUnix的朋友們 轉載本站內容請注明原作者名及出處

清除 Cookies - ChinaUnix - Archiver - WAP - TOP
   日韩综合区视频第一页导航,无码JK粉嫩小泬在线观看,午夜精品A片一区二区三区,日日躁夜夜躁狠狠躁麻豆,大胆国模,免费观看无遮挡www的网站