纯lsp实现去教育版（不支持64位）

tryhi

敢想象吗？仅仅一个4.3KB的fas实现了去教育版，以前要么用exe，要么用arx，纯lsp(fas)应该还没人做过吧，目前支持2002、2004-2014、2019，(2015-2018本身就没有教育版用不到)使用函数的方式而不是命令的方式，方便打包，也方便自己定义是否使用

续：大意了，没测试64位贸然发上来，发现不支持64位CAD，无法实现64位指针式硬伤

2. ;;使用示例
   
3. (defun c:tt (/ q)
   
4.         (setq q(try-qjyb));对CAD进行去教育版
   
5.         (if(= q "ban_ben_bu_zhi_chi")
   
6.                 (princ"\n仅支持2002、2004-2014、2019")
   
7.         )
   
8.         (if(= q "OK")
   
9.                 (princ"\n去教育版运行成功")
   
10.         )
    
11.         (if(null q)
    
12.                 (princ"\n去教育版运行失败")
    
13.         )
    
14.         (princ)
    
15. )
    

;;使用示例<br /> (defun c:tt (/ q)<br />         (setq q(try-qjyb));对CAD进行去教育版<br />         (if(= q "ban_ben_bu_zhi_chi")<br />                 (princ"\n仅支持2002、2004-2014、2019")<br />         )<br />         (if(= q "OK")<br />                 (princ"\n去教育版运行成功")<br />         )<br />         (if(null q)<br />                 (princ"\n去教育版运行失败")<br />         )<br />         (princ)<br /> )<br />

MZ_li

好久没碰到教育版的了

小毛草

这个另一位弟兄做的去教育版！可以看下，不过要加一个控件
;|*************************************************************;
软件作者: Highflybird                                          ;
软件用途: 消除CAD教育版戳记                                    ;
日期地点: 2019.05.12 深圳                                      ;
程序语言: AutoLISP,Visual LISP                                 ;
版本号:   Ver. 1.0.19.0512                                     ;
===============================================================;
================================================================
本软件为开源软件: 以下是开源申明:                              
----------------------------------------------------------------
本页面的软件遵照 GPL协议开放源代码，您可以自由传播和修改，在遵照
下面的约束条件的前提下:                                         
                                                               
一. 只要你在本开源软件的每一副本上明显和恰当地出版版权声明，保持
    此许可证的声明和没有担保的声明完整无损，并和程序一起给每个其
    他的程序接受者一份许可证的副本，你就可用任何媒体复制和发布你
    收到的原始程序的源代码。你也可以为转让副本的实际行动收取一定
    费用，但必须事先得到的同意。                                
二. 你可以修改本开源软件的一个或几个副本或程序的任何部分，以此形
    成基于程序的作品。只要你同时满足下面的所有条件，你就可以按前
    面第一款的要求复制和发布这一经过修改的程序或作品。         
  1.你必须在修改的文件中附有明确说明：你修改了这一文件及具体的修
    改日期。                                                   
  2.你必须使你发布或出版的作品（它包含程序的全部或一部分，或包含
    由程序的全部或部分衍生的作品）允许第三方作为整体按许可证条款
    免费使用。                                                  
  3.如果修改的程序在运行时以交互方式读取命令，你必须使它在开始进
    入常规的交互使用方式时打印或显示声明: 包括适当的版权声明和没
    有担保的声明（或者你提供担保的声明）；用户可以按此许可证条款
    重新发布程序的说明；并告诉用户如何看到这一许可证的副本。（例
    外的情况: 如果原始程序以交互方式工作，它并不打印这样的声明，
    你的基于程序的作品也就不用打印声明。                        
三. 只要你遵循一、二条款规定，您就可以自由使用并传播本源代码，但
    必须原封不动地保留原作者信息。                              
================================================================
**************************************************************|;
(defun c:QQQ (/ acdb addr DWX flag H isOK name pDest pEMR pFlag)
  (if (setq dwx (vlax-create-object "DynamicWrapperX"))
    (progn
      (DWX:Register DWX)
      (setq acdb (strcat "acdb" (substr (getvar "acadver") 1 2) ".dll"))
      (setq h (vlax-invoke DWX 'GetModuleHandle acdb))
      (setq Name (strcat (chr 63) "isEMR@AcDbDatabase@@"))
      (if (= (vlax-invoke DWX 'bitness) 32)
        (setq Name (strcat name "QBE_NXZ")
              pEMR (vlax-invoke DWX 'GetProcAddress h name)
              Addr (+ pEMR 3)
        )
        (setq Name (strcat name "QEBA_NXZ")
              pEMR (vlax-invoke DWX 'GetProcAddress h name)
              Addr (+ pEMR 4)
        )
      )
      (vlax-invoke DWX 'Register acdb name "r=l")
      (if (zerop pEMR)
        (princ "\n你运行的CAD版本可能是2015-2018，它会自动消除教育版!")
        (progn
          (if  (<= (read (substr acdb 5 2)) 16)
            (ForR2006 DWX pEMR)
            (progn
              ;;寻找关键字0x33,0x39,0x0f
              (EMRCheckFunc DWX 'Addr "33" 2)
              (setq pDest Addr)
              (EMRCheckFunc DWX 'Addr "39" 6)
              (EMRCheckFunc DWX 'Addr "0F" 2)
              ;;写内存
              (setq pFlag (vlax-invoke DWX 'memAlloc 4 1))
              (setq isOK (vlax-invoke DWX 'VirtualProtect pDest 100 4 pFlag))
              (if (/= isOK 0)
                (progn
                  (vlax-invoke DWX 'Memwrite "89" pDest)
                  (setq flag (vlax-invoke DWX 'NumGet pFlag))
                  (setq isOK (vlax-invoke DWX 'VirtualProtect pDest 100 flag pFlag))
                  (if (zerop isOK)
                    (princ "\n程序运行失败!")
                    (princ "\n程序运行成功!")
                  )
                )
              )
              (vlax-invoke DWX 'MemFree pFlag)
            )
          )
        )
      )
    )
    (princ "\n你没有注册DynamicWrapperX!或者没有权限!")
  )
  (princ)
)

;;;=============================================================
;;; 功能: 注册一些与内存相关函数                                
;;; 输入: DynamicWrapperX对象。                                 
;;; 输出: 无。                                                  
;;;=============================================================
(defun DWX:Register (DWX)
  (vlax-invoke DWX 'Register "KERNEL32" "LoadLibrary" "i=s" "r=p")
  (vlax-invoke DWX 'Register "KERNEL32" "FreeLibrary" "i=p" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "GetCurrentProcessId" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "OpenProcess" "i=lll" "r=p")
  (vlax-invoke DWX 'Register "KERNEL32" "VirtualProtect" "i=pllp" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "VirtualProtectEx" "i=hpllp" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "VirtualQueryEx" "i=hppl" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "ReadProcessMemory" "i=hpplp" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "WriteProcessMemory" "i=hpplp" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "GetProcAddress" "i=hs" "r=p")
  (vlax-invoke DWX 'Register "KERNEL32" "GetModuleHandle" "i=s" "r=h")
  (vlax-invoke DWX 'Register "KERNEL32" "GetLastError" "r=l")
)

;;;=============================================================
;;; 功能: 检查标志与函数                                       
;;; 输入: DynamicWrapperX对象。                                 
;;; 输出: 无。                                                  
;;;=============================================================
(defun EMRCheckFunc (DWX Address value len / ptr pass)
  (setq ptr (eval Address))
  ;;检查是否时跳转，跳转符号 E9
  (if (= (vlax-invoke DWX 'MemRead ptr 1) "E9")
    (setq pass (vlax-invoke DWX 'NumGet ptr 1)
          ptr  (+ ptr pass 5)
    )
  )
  ;;检查是否为指定值，如果不是返回0
  (if (= (vlax-invoke DWX 'MemRead ptr 1) value)
    (set Address (+ len ptr))
  )
)

;;;=============================================================
;;; 功能: 为2000-2006改写                                       
;;; 输入: DynamicWrapperX对象和isEMR函数地址。                  
;;; 输出: 无。                                                  
;;;=============================================================
(defun ForR2006 (DWX pEMR / HPROCESS LPFLOLDPROTECT NEWCODE OLDCODE OLDTYPE PID POLDCODE TEMP)
  (setq pID (vlax-invoke DWX 'GetCurrentProcessId))
  (setq hProcess (vlax-invoke DWX 'OpenProcess 2035711 0 pID))        ROCESS_ALL_ACCESS = 0x1F0FFF;
  (setq lpflOldProtect (vlax-invoke DWX 'MemAlloc 4 1))
  (setq pOldCode (vlax-invoke DWX 'MemAlloc 19 1))
  (setq temp (vlax-invoke DWX 'VirtualProtectEx hProcess pEMR 19 4 lpflOldProtect))AGE_READWRITE = 0x4;
  (setq temp (vlax-invoke DWX 'ReadProcessMemory hProcess pEMR pOldCode 19 0))
  (setq oldCode (vlax-invoke DWX 'MemRead pOldCode 19))
  (setq oldType (vlax-invoke DWX 'NumGet lpflOldProtect))
  (setq newCode (strcat "8B4104B1008888" (substr oldCode 11 8) "8AC1C38AC1C39090"))
  (vlax-invoke DWX 'MemWrite newcode pOldCode 19)
  (vlax-invoke DWX 'WriteProcessMemory hProcess pEMR pOldCode 19 0)
  (vlax-invoke DWX 'VirtualProtectEx hProcess pEMR 19 oldType 0)
  (vlax-invoke DWX 'MemFree lpflOldProtect)
  (vlax-invoke DWX 'MemFree pOldCode)
)

(vl-load-com)

lzspain

小毛草 发表于 2024-8-9 14:44
这个另一位弟兄做的去教育版！可以看下，不过要加一个控件
;|****************************************** ...

这个控件，用cmd提示注册成功，但为何CAD里还是提示未注册或没有权限呢？

crtrccrt

一个字，很牛

jun353835273

牛逼了，以前的lisp版本都是调用dwx的api实现的。

spp_wall

支持海哥！！！！！！！！！！！

pzweng

搞一个支持所有版本的

ssyfeng

怎么会只支持几个版本？按理lisp是不分版本的

lxl217114

高飞鸟版主写过lsp的，不过得用到dwx。

怕怕吓一跳

用的哪个系统函数

czb203

海哥出品必属精品，感谢海大的热心分享