添加链接
link管理
链接快照平台
  • 输入网页链接,自动生成快照
  • 标签化管理网页链接
#接受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格式):
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 的方法输出文件列表(郁闷吧,暂时没找到能完美操作的内置模块)
    http://www.perlmonks.org/?node_id=536223
    how to read unicode filename
  • 复制某个文件夹内的文件 (文件名含unicode字符)
  • 模块: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;
    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",
    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]+)$/;
    @xrr=split(/\x5c\x00/, $_);
    $xrr[$#xrr]
    CopyFileW复制文件时,要在末尾加\x00作为字符串终止符
    否则各种问题=_=
  • 判断文件是否存在:
  • 方法一:先转为短名再判断,不做赘述
    方法二:渣方法,用CreateFileW测试建立同名文件,看是否有冲突
  • 模块:Win32API::File
    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中的方法
    效率要高得多
    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>;
  • 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;
    GetFileAttributes 的返回值常量列表,可参考 MSDN 官方文档:
    https://msdn.microsoft.com/en-us/librar ... s.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";
    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;
  •