Perl/Tk Dropsite：拖拽含任意Unicode名称的Windows文件问题求助

问题根源在于原DropSite示例调用的是Windows ANSI编码的拖拽接口，非本地代码页的字符会被截断为?。要处理任意Unicode文件名，必须改用Windows的Unicode原生接口获取宽字符文件名，再转换为Perl支持的UTF-8格式。

具体实现步骤 #

1. 安装依赖模块Win32::API，用于调用Windows原生Unicode函数：

cpan Win32::API

2. 重写DropSite的文件处理逻辑，替换ANSI接口为Unicode接口：

use strict;
use warnings;
use Tk;
use Win32::API;
use Encode qw(decode encode);

# 导入Windows Unicode版拖拽函数
Win32::API->Import('shell32', 'DWORD DragQueryFileW(HANDLE hDrop, UINT iFile, LPWSTR lpszFile, UINT cch)');
Win32::API->Import('shell32', 'void DragFinish(HANDLE hDrop)');

my $main_win = MainWindow->new(-title => 'Unicode拖拽测试');
my $listbox = $main_win->Listbox(-width => 60, -height => 15)->pack(-fill => 'both', -expand => 1);

# 配置DropSite
$listbox->DropSite(
    -dropcommand => \&handle_drop,
    -droptypes   => ['Win32'],
);

sub handle_drop {
    my ($widget, $selection, $x, $y) = @_;
    my $drop_handle = $selection->{DROP_HANDLE};

    # 获取拖拽的文件总数
    my $file_count = DragQueryFileW($drop_handle, 0xFFFFFFFF, 0, 0);

    for my $idx (0 .. $file_count - 1) {
        # 先获取宽字符文件名的长度（不含终止符）
        my $buf_length = DragQueryFileW($drop_handle, $idx, 0, 0);
        # 分配缓冲区：每个宽字符占2字节，加终止符
        my $wide_buf = "\x00" x ($buf_length * 2 + 2);
        # 读取宽字符文件名
        DragQueryFileW($drop_handle, $idx, $wide_buf, $buf_length + 1);
        # 将Windows宽字符（UCS-2LE）转换为Perl UTF-8字符串
        my $utf8_filename = encode('utf-8', decode('UCS-2le', $wide_buf));
        # 移除可能的空字符截断
        $utf8_filename =~ s/\x00+$//;
        # 添加到列表框
        $listbox->insert('end', $utf8_filename);
    }

    # 释放拖拽句柄
    DragFinish($drop_handle);
}

MainLoop;

注意事项 #

• 确保脚本保存为UTF-8格式，运行时Perl环境支持UTF-8处理
• 如果列表框显示乱码，可尝试设置组件的字体为支持Unicode的字体（如-font => 'Microsoft YaHei 10'）
• 测试时使用包含西里尔文、德文等非本地代码页字符的文件名，验证识别效果

内容的提问来源于stack exchange，提问作者Sadko