返回列表 发帖

[技术讨论] [探讨]Perl的Win32::Clipboard Set写入剪切板乱码问题

环境 Perl (v5.16.3) built for MSWin32-x86
单独开帖,涉及到修改XS文件

    乱码现象:Win32::Clipboard复制中文字符到剪切板乱码
    当时的解决办法就是设置系统默认输入法为中文。但是我不希望每次打开终端、所有应用程序都
  是默认中文。解决该问题的页面链接如下:
  https://www.mail-archive.com/libwin32%40perl.org/msg00605.html
  如果你不能翻墙,请看这里:
  https://rt.cpan.org/Public/Bug/Display.html?id=76042
  点击右下角的: 下载 Win32-Clipboard-0.57.diff.txt

  PO主增加了USet 函数 以及 UGet 函数,并且提供了一份由diff命令生成的对比文件 diff.txt ,
  上面显示是0.56 和0.57的对比,实际上CPAN 上的0.57版本是没有USet函数的,这个版本是
  作者自己加上去的,所以还是要自己改。

首先下载 Win32-Clipboard-0.56.tar.gz
解压后通过patch命令对文件进行修改,或者手工修改clipboard.xs:

在470行插入
void
USet(text)
    SV *text
PPCODE:
    HANDLE myhandle;
    HGLOBAL hGlobal;
    STRLEN leng;
    U8 *str = (U8*) SvPV(text, leng);
    if ( hGlobal = GlobalAlloc(GMEM_DDESHARE, (leng+2)*sizeof(char)*2) ) {
        /* here we encode UTF16-LE from UTF8, using perl API */
        wchar_t *szString = (wchar_t *) GlobalLock(hGlobal);
    if(SvUTF8(text)) {
        /* indeed, we have utf8 data */
        U8 * const send = str + leng;
        STRLEN ulen;
        while (str < send) {
        *szString++ = (wchar_t)utf8_to_uvchr(str, &ulen);
        str += ulen;
        }
    } else {
        /* we have raw data, no encoding to UTF8, so converting
         * binarily means appending waw '\0' to each char */
        U8 * const send = str + leng;
        while (str < send) {
        *szString++ = (wchar_t) *str++;
        }
    }
    *szString = '\0';
        GlobalUnlock(hGlobal);
        if ( OpenClipboard(NULL) ) {
            EmptyClipboard();
            myhandle = SetClipboardData(CF_UNICODETEXT, (HANDLE) hGlobal);
            CloseClipboard();
            if ( myhandle ) {
                XSRETURN_YES;
            } else {
                XSRETURN_NO;
            }
        } else {
            GlobalFree(hGlobal);
            XSRETURN_NO;
        }
    } else {
        XSRETURN_NO;
    }COPY
void
UGet()
PPCODE:
    HANDLE myhandle;
    if(OpenClipboard(NULL)) {
    EXTEND(SP,1);
    if(myhandle = GetClipboardData(CF_UNICODETEXT)) {
        /* here we decode UTF16-LE into UTF8, using perl API */
        wchar_t *wcmyh = (wchar_t*)myhandle;
            int i, len = wcslen(wcmyh);
            SV *sv = newSV(len * UTF8_MAXBYTES +1);
        SvPOK_on(sv);
            U8 *e = (U8*) SvPVX(sv), *e0 = e;
        for (i=0; i<len; i++) {
        e = uvuni_to_utf8(e, wcmyh[i]);
        }
        *e = 0;
        SvCUR_set(sv, e-e0);
        SvUTF8_on(sv);
        ST(0) = sv_2mortal(sv);
    } else
        XST_mNO(0);
    CloseClipboard();
    XSRETURN(1);
    } else {
    XSRETURN_NO;
    }COPY
long
IsText(...)
CODE:
        RETVAL = (long) IsClipboardFormatAvailable(CF_TEXT);
OUTPUT:
        RETVALCOPY
后面插入:
long
IsUText(...)
CODE:
    RETVAL = (long) IsClipboardFormatAvailable(CF_UNICODETEXT);
OUTPUT:
    RETVALCOPY
然后
>perl Makefile.pl
>dmake
>dmake test
>dmake install

即可使用 USet 函数,示例脚本1(保存为utf-8格式):
use Win32::Clipboard;
use utf8;
$str = "中文abc";
Win32::Clipboard::USet($str);
[url=][/url]

返回列表