忘记密码   免费注册 查看新帖 | 论坛精华区

ChinaUnix.net

  平台 论坛 博客 认证专区 大话IT HPC论坛 徽章 文库 沙龙 自测 下载 频道自动化运维 虚拟化 储存备份 C/C++ PHP MySQL 嵌入式 Linux系统
12下一页
最近访问板块 发新帖
查看: 4246 | 回复: 14

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

论坛徽章:
9
子鼠
日期:2014-10-11 16:46:482015亚冠之萨济拖拉机
日期:2015-05-22 11:38:53黑曼巴
日期:2016-07-19 15:03:1115-16赛季CBA联赛之四川
日期:2017-05-16 16:38:5515-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:552016科比退役纪念章
日期:2017-09-02 15:42:47
发表于 2017-05-16 14:58 |显示全部楼层
本帖最后由 523066680 于 2017-05-16 16:37 编辑

环境 XP/WIN7 Active Perl v5.16
编辑整理:523066680
原帖:http://code-by.org/viewtopic.php?f=17&t=131

以下主要讨论用 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"
            );

获取文件的日期信息


    普通文件名的情况

      [how-can-i-get-a-files-modification-date-in-ddmmyy-format-in-perl](http://stackoverflow.com/questions/1839877/)

    含有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 赞一个!

查看全部评分

打赏鼓励一下!

论坛徽章:
9
子鼠
日期:2014-10-11 16:46:482015亚冠之萨济拖拉机
日期:2015-05-22 11:38:53黑曼巴
日期:2016-07-19 15:03:1115-16赛季CBA联赛之四川
日期:2017-05-16 16:38:5515-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:552016科比退役纪念章
日期:2017-09-02 15:42:47
发表于 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 ~ ~

查看全部评分

论坛徽章:
9
子鼠
日期:2014-10-11 16:46:482015亚冠之萨济拖拉机
日期:2015-05-22 11:38:53黑曼巴
日期:2016-07-19 15:03:1115-16赛季CBA联赛之四川
日期:2017-05-16 16:38:5515-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:552016科比退役纪念章
日期:2017-09-02 15:42:47
发表于 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

论坛徽章:
9
子鼠
日期:2014-10-11 16:46:482015亚冠之萨济拖拉机
日期:2015-05-22 11:38:53黑曼巴
日期:2016-07-19 15:03:1115-16赛季CBA联赛之四川
日期:2017-05-16 16:38:5515-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:552016科比退役纪念章
日期:2017-09-02 15:42:47
发表于 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;
}

论坛徽章:
5
数据库技术版块每日发帖之星
日期: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:44
发表于 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
发表于 2017-05-16 17:58 |显示全部楼层
如果您还在的话,可否试下?
badName.rar (11.28 KB, 下载次数: 0)

论坛徽章:
9
子鼠
日期:2014-10-11 16:46:482015亚冠之萨济拖拉机
日期:2015-05-22 11:38:53黑曼巴
日期:2016-07-19 15:03:1115-16赛季CBA联赛之四川
日期:2017-05-16 16:38:5515-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:552016科比退役纪念章
日期:2017-09-02 15:42:47
发表于 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
发表于 2017-05-16 18:16 |显示全部楼层
本帖最后由 sunzhiguolu 于 2017-05-16 18:22 编辑

回复 7# 523066680
度娘分享

如果不行,我再换种方式将文件发出来。

论坛徽章:
9
子鼠
日期:2014-10-11 16:46:482015亚冠之萨济拖拉机
日期:2015-05-22 11:38:53黑曼巴
日期:2016-07-19 15:03:1115-16赛季CBA联赛之四川
日期:2017-05-16 16:38:5515-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:552016科比退役纪念章
日期:2017-09-02 15:42:47
发表于 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
发表于 2017-05-16 19:09 |显示全部楼层
版主,牛X 的帖子赶快加精华
另外, 把我那篇加精华的帖子随便找个各方丢了吧。哈哈哈,服了。。。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

SACC2017购票8.8折优惠进行时

2017中国系统架构师大会(SACC2017)将于10月19-21日在北京新云南皇冠假日酒店震撼来袭。今年,大会以“云智未来”为主题,云集国内外顶级专家,围绕云计算、人工智能、大数据、移动互联网、产业应用等热点领域展开技术探讨与交流。本届大会共设置2大主会场,18个技术专场;邀请来自互联网、金融、制造业、电商等多个领域,100余位技术专家及行业领袖来分享他们的经验;并将吸引4000+人次的系统运维、架构师及IT决策人士参会,为他们提供最具价值的交流平台。
----------------------------------------
优惠时间:2017年8月2日前

活动链接>>
  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号 北京市公安局海淀分局网监中心备案编号:11010802020122
广播电视节目制作经营许可证(京) 字第1234号 中国互联网协会会员  联系我们:
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP