利用DynamicWrapperX实现字符转换

highflybird 周二, 01/26/2021 - 01:30

以下的代码需要DynamicWrapperX的支持。关于DynamicWrapperX的介绍，请看这个帖子：

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=172340&highlight=dynamicwrapper

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85724&highlight=dynamicwrapper

最新版本是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)

 

编程