纯lsp实现去教育版（不支持64位）
本帖最后由 tryhi 于 2024-8-6 12:01 编辑敢想象吗？仅仅一个4.3KB的fas实现了去教育版，以前要么用exe，要么用arx，纯lsp(fas)应该还没人做过吧，目前支持2002、2004-2014、2019，(2015-2018本身就没有教育版用不到)使用函数的方式而不是命令的方式，方便打包，也方便自己定义是否使用
续：大意了，没测试64位贸然发上来，发现不支持64位CAD，无法实现64位指针式硬伤
;;使用示例
(defun c:tt (/ q)
(setq q(try-qjyb));对CAD进行去教育版
(if(= q "ban_ben_bu_zhi_chi")
(princ"\n仅支持2002、2004-2014、2019")
)
(if(= q "OK")
(princ"\n去教育版运行成功")
)
(if(null q)
(princ"\n去教育版运行失败")
)
(princ)
)
好久没碰到教育版的了 这个另一位弟兄做的去教育版！可以看下，不过要加一个控件
;|*************************************************************;
软件作者: 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)) ;PROCESS_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));PAGE_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) 小毛草 发表于 2024-8-9 14:44
这个另一位弟兄做的去教育版！可以看下，不过要加一个控件
;|****************************************** ...
这个控件，用cmd提示注册成功，但为何CAD里还是提示未注册或没有权限呢？ 一个字，很牛 牛逼了，以前的lisp版本都是调用dwx的api实现的。 支持海哥！！！！！！！！！！！ 搞一个支持所有版本的 怎么会只支持几个版本？按理lisp是不分版本的 高飞鸟版主写过lsp的，不过得用到dwx。 用的哪个系统函数 海哥出品必属精品，感谢海大的热心分享