利用DynamicWrapperX实现字符转换
highflybird
- 登录 发表评论
以下的代码需要DynamicWrapperX的支持。关于DynamicWrapperX的介绍，请看这个帖子：
越飞越高讲堂（2）CAD的API编程指南(上)--DynamicWrapperX
最新版本是2.2.0，其下载地址是：
http://dynwrapx.script-coding.com/dwx/pages/dynwrapx.php?lang=en
利用它，可以用LISP实现字符的转换（包括简体转繁体，GB2312转BIG5,GBK等等）。
下面是其实现代码：
;|*************************************************************;
软件作者: Highflybird ;
软件用途: 通过DynamicWrapperX插件实现汉字简繁转换(字符集转换) ;
日期地点: 2016.05.14 深圳 ;
程序语言: AutoLISP,Visual LISP ;
版本号: Ver. 1.16.0514 ;
===============================================================;
================================================================
本软件为开源软件: 以下是开源申明:
----------------------------------------------------------------
本页面的软件遵照 GPL协议开放源代码，您可以自由传播和修改，在遵照
下面的约束条件的前提下:
一. 只要你在本开源软件的每一副本上明显和恰当地出版版权声明，保持
此许可证的声明和没有担保的声明完整无损，并和程序一起给每个其
他的程序接受者一份许可证的副本，你就可用任何媒体复制和发布你
收到的原始程序的源代码。你也可以为转让副本的实际行动收取一定
费用，但必须事先得到的同意。
二. 你可以修改本开源软件的一个或几个副本或程序的任何部分，以此形
成基于程序的作品。只要你同时满足下面的所有条件，你就可以按前
面第一款的要求复制和发布这一经过修改的程序或作品。
1.你必须在修改的文件中附有明确说明：你修改了这一文件及具体的修
改日期。
2.你必须使你发布或出版的作品（它包含程序的全部或一部分，或包含
由程序的全部或部分衍生的作品）允许第三方作为整体按许可证条款
免费使用。
3.如果修改的程序在运行时以交互方式读取命令，你必须使它在开始进
入常规的交互使用方式时打印或显示声明: 包括适当的版权声明和没
有担保的声明（或者你提供担保的声明）；用户可以按此许可证条款
重新发布程序的说明；并告诉用户如何看到这一许可证的副本。（例
外的情况: 如果原始程序以交互方式工作，它并不打印这样的声明，
你的基于程序的作品也就不用打印声明。
三. 只要你遵循一、二条款规定，您就可以自由使用并传播本源代码，但
必须原封不动地保留原作者信息。
================================================================
**************************************************************|;
;;;-------------------------------------------------------------
;;; 说明：此程序仅在简体中文系统中测试通过，繁体中文可能需做改变
;;;-------------------------------------------------------------
(defun C:test (/ DWX l1 l2 l3)
(setq DWX (vlax-create-object "DynamicWrapperX"))
(DWX:CharsetAPI DWX)
;(DWX:FileIO DWX)
(setq l1 '("CAD简繁转化" DWX:GB2312->GBK DWX:GB2312->BIG5))
(setq l2 '("CAD簡繁轉化" DWX:GBK->GB2312 DWX:GBK->BIG5))
(setq l3 '("CAD虏羉锣て" DWX:BIG5->GBK DWX:BIG5->GB2312))
(foreach n (list l1 l2 l3)
(princ (strcat "\nBefore: " (car n)))
(foreach f (cdr n)
(princ (strcat "\nAfter " (vl-princ-to-string f) ": "))
(princ (apply f (list DWX (car n))))
)
)
;;; (if (setq Name (Getfiled "请选择文件" "c:/" "" 8))
;;; (progn
;;; (setq text (DWX:ReadTxt DWX Name nil))
;;; (setq str1 (DWX:GB2312->BIG5 DWX text))
;;; (setq file (open "C:\\CharConvert-tw.lsp" "w"))
;;; (princ str1 file)
;;; (close file)
;;; (setq str2 (DWX:GB2312->GBK DWX text))
;;; (setq file (open "C:\\CharConvert-HK.lsp" "w"))
;;; (princ str2 file)
;;; (close file)
;;; )
;;; )
(vlax-release-object DWX)
(princ)
)
;;;-------------------------------------------------------------
;;; GB2312->GBK 简体转繁体
;;;-------------------------------------------------------------
(defun DWX:GB2312->GBK (DWX STR)
(DWX:LCMapString DWX STR 67108864) ;67108864, LCMAP_TRADITIONAL_CHINESE
)
;;;-------------------------------------------------------------
;;; GBK->GB2312 繁体转简体
;;;-------------------------------------------------------------
(defun DWX:GBK->GB2312 (DWX STR / nlen pStr)
(DWX:LCMapString DWX STR 33554432) ;33554432, LCMAP_SIMPLIFIED_CHINESE
)
;;;-------------------------------------------------------------
;;; BIG5->GBK BIG5转繁体
;;;-------------------------------------------------------------
(defun DWX:BIG5->GBK (DWX str)
(DWX:ANSI->Unicode DWX str 950) ;ANSI/OEM Traditional Chinese (Taiwan; Hong Kong SAR, PRC)
)
;;;-------------------------------------------------------------
;;; GBK->BIG5 繁体转BIG5
;;;-------------------------------------------------------------
(defun DWX:GBK->BIG5 (DWX str)
(DWX:Unicode->ANSI DWX str 950) ; Chinese Traditional (Big5)
)
;;;-------------------------------------------------------------
;;; GB2312->BIG5 简体转BIG5
;;;-------------------------------------------------------------
(defun DWX:GB2312->BIG5 (DWX STR)
(DWX:GBK->BIG5 DWX (DWX:GB2312->GBK DWX STR))
)
;;;-------------------------------------------------------------
;;; BIG5->GB2312 BIG5转简体
;;;-------------------------------------------------------------
(defun DWX:BIG5->GB2312 (DWX STR)
(DWX:GBK->GB2312 DWX (DWX:BIG5->GBK DWX STR))
)
;;;-------------------------------------------------------------
;;; JPN->GBK 日文转繁体
;;;-------------------------------------------------------------
(defun DWX:JPN->GBK (DWX str)
(DWX:ANSI->Unicode DWX str 932)
)
;;;-------------------------------------------------------------
;;; GBK->JPN 繁体转日文
;;;-------------------------------------------------------------
(defun DWX:GBK->JPN (DWX str)
(DWX:Unicode->ANSI DWX str 932)
)
;;;-------------------------------------------------------------
;;; For a locale specified by identifier,maps an input character
;;; string to another using a specified transformation, or
;;; generates a sort key for the input string.
;;; 1024 -- LOCALE_USER_DEFAULT
;;;-------------------------------------------------------------
(defun DWX:LCMapString (DWX STR MapFlags / nlen pStr)
(setq nLen (vlax-invoke DWX 'LCMapStringW 1024 MapFlags str -1 0 0))
(setq pStr (vlax-invoke DWX 'memAlloc (+ nLen nLen 2) 1))
(setq nLen (vlax-invoke DWX 'LCMapStringW 1024 MapFlags str -1 pStr nLen))
(setq str (vlax-invoke DWX 'StrGet pStr "w"))
(vlax-invoke DWX 'MemFree pStr)
str
)
;;;-------------------------------------------------------------
;;; ANSI->Unicode 指定代码页转换为Unicode
;;;-------------------------------------------------------------
(defun DWX:ANSI->Unicode (DWX STR Code / nLen pStr)
(setq nLen (vlax-invoke DWX 'MultiByteToWideChar Code 0 str -1 0 0))
(setq pStr (vlax-invoke DWX 'memAlloc (+ nLen nLen 2) 1))
(setq nLen (vlax-invoke DWX 'MultiByteToWideChar Code 0 str -1 pStr nLen))
(setq str (vlax-invoke DWX 'StrGet pStr "w"))
(vlax-invoke DWX 'MemFree pStr)
str
)
;;;-------------------------------------------------------------
;;; Unicode->ANSI Unicode转换为指定代码页
;;;-------------------------------------------------------------
(defun DWX:Unicode->ANSI (DWX STR Code / nLen pStr)
(setq nLen (vlax-invoke DWX 'WideCharToMultiByte Code 0 str -1 0 0 0 0))
(setq pStr (vlax-invoke DWX 'memAlloc (1+ nLen) 1))
(setq nLen (vlax-invoke DWX 'WideCharToMultiByte Code 0 str -1 pStr nLen 0 0))
(setq str (vlax-invoke DWX 'StrGet pStr "s"))
(vlax-invoke DWX 'MemFree pStr)
str
)
;;;-------------------------------------------------------------
;;; 注册字符集转换的API
;;;-------------------------------------------------------------
(defun DWX:CharSetAPI (DWX)
(vlax-invoke DWX 'Register "Kernel32" "MultiByteToWideChar" "i=llslpl" "r=l")
(vlax-invoke DWX 'Register "Kernel32" "WideCharToMultiByte" "i=llwlplpp" "r=l")
(vlax-invoke DWX 'Register "Kernel32" "LCMapStringA" "i=llslpl" "r=l")
(vlax-invoke DWX 'Register "Kernel32" "LCMapStringW" "i=llwlpl" "r=l")
(vlax-invoke DWX 'Register "Kernel32" "lstrlen" "i=p" "r=l")
)
(vl-load-com)