我也来个VLISP直接调用WIN API函数

yyzhan12 · 发表于 2009-3-5 08:18:00

本帖最后由 yyzhan12 于 2022-2-2 23:53 编辑

Vlisp直接调用Win API通用函数：c:ysx-use-api by yyzhan12

baitang36 · 发表于 2024-7-15 09:12:14

本帖最后由 baitang36 于 2024-7-15 09:15 编辑

cchessbd 发表于 2022-10-5 17:40
这不好吧，花了钱也学习不到知识。。。

15年以前的老代码了，让大家看看是怎么实现的。如果作者介意，请回复，马上删除
(SETVAR "cmdecho" 0)
(DEFUN C:YSX-USE-API (CZSX             APISM
                  APINAME             CSLIST
                  /                      C:YSX-LOAD-VBA
                  C:YSX-FUNCTION-API
                  C:YSX-USE-VBABAS C:YSX-UNLOAD-DVB
                  )
  (DEFUN C:YSX-LOAD-VBA       ()
(if       (AND (= (MEMBER "acvba.arx" (ARX)) nil)
         (= (MEMBER "acadvba.arx" (ARX)) nil)
      )
   (PROGN
      (VL-CATCH-ALL-APPLY 'ARXLOAD (LIST (FINDFILE "acvba.arx")))
      (VL-CATCH-ALL-APPLY
      'ARXLOAD
      (LIST (FINDFILE "acadvba.arx"))
      )
      (PRINC "\r                                     \n")
   )
)
(PRINC)
  )

  (DEFUN C:YSX-FUNCTION-API (APISM CZSX    CSLIST       APINAME
                           /             VARLIST  FHZ       CADOBJ
                           CADVBA BASTEXT  VBAYJ       DGLIST
                        )
(VL-LOAD-COM)
(PRINT)
(setq VARLIST (MAPCAR 'GETVAR (LIST "cmdecho" "users1")))
(MAPCAR 'SETVAR (LIST "cmdecho" "users1") (LIST 0 ""))
(setq FHZ nil)
(C:YSX-LOAD-VBA)
(if
   (AND (OR (MEMBER "acvba.arx" (ARX)) (MEMBER "acadvba.arx" (ARX)))
         (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI")
   )
   (PROGN
      (setq CADOBJ (vlax-get-acad-object))
      (command "_.vbanew")
      (command "_.vbanew")
      (setq CADVBA
            (vlax-get
               (vlax-get (vlax-get CADOBJ 'VBE) 'ACTIVEVBPROJECT)
               'VBCOMPONENTS
            )
      )
      (COND
         ((/= APISM 888)
         (setq
            BASTEXT (APPEND
                     BASTEXT
                     (LIST APISM
                           "Sub AutoCadVLispUseVbaWinSystemApi()"
                           "dim fhz"
                           "On Error Resume Next"
                     )
                  )
         )
         (COND
            ((= CSLIST nil)
            (setq BASTEXT
                  (APPEND BASTEXT
                           (LIST (STRCAT "fhz = " APINAME "()"))
                  )
            )
            )
            ((/= CSLIST nil)
            (setq VBAYJ "")
            (FOREACH       DGLIST CSLIST
               (if (= VBAYJ "")
               (PROGN (setq VBAYJ (VL-PRIN1-TO-STRING DGLIST)))
               (PROGN (setq       VBAYJ (STRCAT VBAYJ
                                          ","
                                          (VL-PRIN1-TO-STRING DGLIST)
                                    )
                        )
               )
               )
            )
            (while
               (and
               (VL-STRING-SEARCH (STRCASE "\\\\") (STRCASE VBAYJ))
               )
               (setq       VBAYJ (VL-STRING-SUBST
                              "\\"
                              (STRCASE "\\\\")
                              (STRCASE VBAYJ)
                           )
               )
            )
            (setq BASTEXT
                  (APPEND
                     BASTEXT
                     (LIST (STRCAT "fhz = " APINAME "(" VBAYJ ")")
                     )
                  )
            )
            )
         )
         (COND ((= CZSX nil)
               (setq BASTEXT
                        (APPEND
                        BASTEXT
                        (LIST
                           "ThisDrawing.SetVariable \"users1\", CStr(fhz)"
                        )
                        )
               )
               )
               ((= CZSX T)
               (setq BASTEXT
                        (APPEND
                        BASTEXT
                        (LIST
                           "ThisDrawing.SetVariable \"users1\", fhz"
                        )
                        )
               )
               )
         )
         (setq BASTEXT (APPEND BASTEXT (LIST "End Sub")))
         (setq APINAME "AutoCadVLispUseVbaWinSystemApi")
         )
         ((= APISM 888) (setq BASTEXT CSLIST))
      )
      (C:YSX-USE-VBABAS APISM CADVBA BASTEXT APINAME)
      (C:YSX-UNLOAD-DVB)
      (if (/= (GETVAR "users1") "")
         (PROGN
         (COND ((= CZSX nil) (setq FHZ (READ (GETVAR "users1"))))
               ((= CZSX T) (setq FHZ (GETVAR "users1")))
         )
         )
      )
   )
)
(MAPCAR 'SETVAR (LIST "cmdecho" "users1") VARLIST)
FHZ
  )
  (vl-ACAD-defun 'C:YSX-FUNCTION-API)
  (DEFUN C:YSX-USE-VBABAS
      (APISM CADVBA TEXTLIST VBANAME / WRTEXT DGLIST)
(setq WRTEXT "")
(FOREACH DGLIST TEXTLIST
   (if (= WRTEXT "")
      (PROGN (setq WRTEXT DGLIST))
      (PROGN (setq WRTEXT (STRCAT WRTEXT "\n" DGLIST)))
   )
)
(vlax-invoke-method
   (vlax-get       (vlax-get (vlax-get (vlax-get-acad-object) 'VBE)
                        'SELECTEDVBCOMPONENT
            )
            'CODEMODULE
   )
   'ADDFROMSTRING
   WRTEXT
)
(VL-VBARUN (STRCAT "ThisDrawing." VBANAME))
(PRINC)
  )
  (vl-ACAD-defun 'C:YSX-USE-VBABAS)
  (DEFUN C:YSX-UNLOAD-DVB (/ FHZ CADOBJ DVBNAME DVBZBJ)
(setq FHZ nil)
(setq CADOBJ (vlax-get-acad-object))
(setq DVBNAME
         (vlax-get (vlax-get (vlax-get CADOBJ 'VBE) 'MAINWINDOW)
                  'CAPTION
         )
)
(PRINC "\r                                     \n")
(setq DVBZBJ "")
(COND ((VL-STRING-SEARCH (STRCASE "全局") (STRCASE DVBNAME))
         (setq DVBZBJ "全局")
      )
      ((VL-STRING-SEARCH (STRCASE "global") (STRCASE DVBNAME))
         (setq DVBZBJ "global")
      )
)
(if       (OR (= (STRCASE DVBZBJ) (STRCASE "全局"))
         (= (STRCASE DVBZBJ) (STRCASE "global"))
      )
   (PROGN (setq DVBNAME (READ (SUBSTR DVBNAME
                                       (+ (VL-STRING-SEARCH
                                          (STRCASE DVBZBJ)
                                          (STRCASE DVBNAME)
                                          )
                                          (+ (STRLEN DVBZBJ) 1)
                                       )
                              )
                        )
         )
         (vlax-invoke-method
            CADOBJ
            'UNLOADDVB
            (CAR (LIST (STRCAT DVBZBJ (ITOA DVBNAME))
                        (vlax-invoke-method
                        (vlax-get-or-create-object "wscript.shell")
                        'SENDKEYS
                        (STRCAT "{N}")
                        )
                  )
            )
         )
         (vlax-invoke-method
            CADOBJ
            'UNLOADDVB
            (STRCAT DVBZBJ (ITOA (+ DVBNAME 1)))
         )
         (setq FHZ T)
   )
)
FHZ
  )
  (vl-ACAD-defun 'C:YSX-UNLOAD-DVB)
  (VL-CATCH-ALL-APPLY
'C:YSX-FUNCTION-API
(LIST APISM CZSX CSLIST APINAME)
  )
)

(DEFUN C:QWERTYUIOPASDFGHJKLZXCVBNM9638527410 () T)

(if (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI")
  (PROGN
(if
   (/= (EQUAL (MAPCAR 'STRCASE
                     (VL-LIST-EXPORTED-FUNCTIONS "Ysx-Vlisp-WinAPI")
               )
               (MAPCAR 'STRCASE
                     (LIST "c:qwertyuiopasdfghjklzxcvbnm9638527410"
                           "c:ysx-use-api"
                     )
               )
      )
      T
   )
   (PROGN (setq C:YSX-USE-API nil)
            (setq C:YSX-LOAD-VBA nil)
            (setq C:YSX-FUNCTION-API nil)
            (setq C:YSX-USE-VBABAS nil)
            (setq C:YSX-UNLOAD-DVB nil)
   )
)
  )
)
(if (= (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI") nil)
  (PROGN (setq C:YSX-USE-API nil)
      (setq C:YSX-LOAD-VBA nil)
      (setq C:YSX-FUNCTION-API nil)
      (setq C:YSX-USE-VBABAS nil)
      (setq C:YSX-UNLOAD-DVB nil)
  )
)
(PRINC)

自贡黄明儒 · 发表于 2024-7-19 15:22:24

baitang36 发表于 2024-7-15 09:12
15年以前的老代码了，让大家看看是怎么实现的。如果作者介意，请回复，马上删除
(SETVAR "cmdecho" 0)
(D ...

一看楼主就是高手，可能都忘记这个程序了。我试了一下，可能公司电脑剪粘板的限制，用不了呀

;|http://bbs.mjtd.com/thread-74063-1-1.html
Vlisp直接调用Win API通用函数：c:ysx-use-api by yyzhan12
参数说明：
1、参数1
API返回值类型，long为nil, string为T
返回值目前仅支持long和string，其他类型的日后完善
2、参数2
API函数声明，文本
3、参数3
API函数名称
4、参数4
API函数参数表
例子：
(c:ysx-use-api nil "Private Declare Function GetCurrentProcessId Lib \"kernel32\" () As Long" "GetCurrentProcessId" nil)
获取进程标识符
(c:ysx-use-api nil "Private Declare Function ShowCursor Lib \"user32\" Alias \"ShowCursor\" (ByVal bShow As Long) As Long" "ShowCursor" (list 1))
显示鼠标
(c:ysx-use-api nil "Private Declare Function ShowCursor Lib \"user32\" Alias \"ShowCursor\" (ByVal bShow As Long) As Long" "ShowCursor" (list 0))
隐藏鼠标
(c:ysx-use-api nil "Private Declare Function CopyFile Lib \"kernel32\" Alias \"CopyFileA\" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long" "CopyFile" (list "c:\\bootfont.bin" "d:\\1.vxd" 0))
复制文件
____________________________________________________________________________________________
Vlisp直接调用Win API函数
解决了以下几个问题:
1、解决了AutoCAD退出时提示保存工程的问题。
2、解决了连续调用API时卸载工程不成功的问题
3、解决命令行多余信息显示的问题
4、解决影响其它工程的问题
5、改进Win API代码的加载方式
6、加强了程序代码反破解功能
|;
;;[加载VBA] 如果没有安装VBA，此函数没有用。
(DEFUN C:YSX-LOAD-VBA ()
(if
(AND (= (MEMBER "acvba.arx" (ARX)) nil)
(= (MEMBER "acadvba.arx" (ARX)) nil)
)
(PROGN
(VL-CATCH-ALL-APPLY 'ARXLOAD (LIST (FINDFILE "acvba.arx")))
(VL-CATCH-ALL-APPLY 'ARXLOAD (LIST (FINDFILE "acadvba.arx")))
(PRINC "\r \n")
)
)
(PRINC)
)
;;[卸载DVB]
(DEFUN C:YSX-UNLOAD-DVB (/ FHZ CADOBJ DVBNAME DVBZBJ)
(setq FHZ nil)
(setq CADOBJ (vlax-get-acad-object))
(setq DVBNAME
(vlax-get (vlax-get (vlax-get CADOBJ 'VBE) 'MAINWINDOW)
'CAPTION
)
)
(PRINC "\r \n")
(setq DVBZBJ "")
(COND ((VL-STRING-SEARCH (STRCASE "全局") (STRCASE DVBNAME))
(setq DVBZBJ "全局")
)
((VL-STRING-SEARCH (STRCASE "global") (STRCASE DVBNAME))
(setq DVBZBJ "global")
)
)
(if (OR (= (STRCASE DVBZBJ) (STRCASE "全局"))
(= (STRCASE DVBZBJ) (STRCASE "global"))
)
(PROGN (setq DVBNAME (READ (SUBSTR DVBNAME
(+ (VL-STRING-SEARCH
(STRCASE DVBZBJ)
(STRCASE DVBNAME)
)
(+ (STRLEN DVBZBJ) 1)
)
)
)
)
(vlax-invoke-method
CADOBJ
'UNLOADDVB
(CAR (LIST (STRCAT DVBZBJ (ITOA DVBNAME))
(vlax-invoke-method
(vlax-get-or-create-object "wscript.shell")
'SENDKEYS
(STRCAT "{N}")
)
)
)
)
(vlax-invoke-method
CADOBJ
'UNLOADDVB
(STRCAT DVBZBJ (ITOA (+ DVBNAME 1)))
)
(setq FHZ T)
)
)
FHZ
)
(vl-ACAD-defun 'C:YSX-UNLOAD-DVB)
;;[使用VBABAS]
(DEFUN C:YSX-USE-VBABAS (APISM CADVBA TEXTLIST VBANAME / WRTEXT DGLIST)
(setq WRTEXT "")
(FOREACH DGLIST TEXTLIST
(if (= WRTEXT "")
(setq WRTEXT DGLIST)
(setq WRTEXT (STRCAT WRTEXT "\n" DGLIST))
)
)
(vlax-invoke-method
(vlax-get
(vlax-get (vlax-get (vlax-get-acad-object) 'VBE)
'SELECTEDVBCOMPONENT
)
'CODEMODULE
)
'ADDFROMSTRING
WRTEXT
)
(VL-VBARUN (STRCAT "ThisDrawing." VBANAME))
(PRINC)
)
(vl-ACAD-defun 'C:YSX-USE-VBABAS)
;;[API]
(DEFUN C:YSX-FUNCTION-API (APISM CZSX CSLIST APINAME /
VARLIST FHZ CADOBJ CADVBA BASTEXT
VBAYJ DGLIST
)
(VL-LOAD-COM)
(PRINT)
(setq VARLIST (MAPCAR 'GETVAR (LIST "cmdecho" "users1")))
(MAPCAR 'SETVAR (LIST "cmdecho" "users1") (LIST 0 ""))
(setq FHZ nil)
(C:YSX-LOAD-VBA)
(if
(AND (OR (MEMBER "acvba.arx" (ARX)) (MEMBER "acadvba.arx" (ARX)))
(VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI")
)
(PROGN
(setq CADOBJ (vlax-get-acad-object))
(command "_.vbanew")
(command "_.vbanew")
(setq
CADVBA (vlax-get
(vlax-get (vlax-get CADOBJ 'VBE) 'ACTIVEVBPROJECT)
'VBCOMPONENTS
)
)
(COND
((/= APISM 888)
(setq BASTEXT
(APPEND BASTEXT
(LIST APISM
"Sub AutoCadVLispUseVbaWinSystemApi()"
"dim fhz"
"On Error Resume Next"
)
)
)
(COND
((= CSLIST nil)
(setq
BASTEXT (APPEND BASTEXT
(LIST (STRCAT "fhz = " APINAME "()"))
)
)
)
((/= CSLIST nil)
(setq VBAYJ "")
(FOREACH DGLIST CSLIST
(if (= VBAYJ "")
(PROGN (setq VBAYJ (VL-PRIN1-TO-STRING DGLIST)))
(PROGN
(setq
VBAYJ
(STRCAT VBAYJ "," (VL-PRIN1-TO-STRING DGLIST))
)
)
)
)
(while
(and (VL-STRING-SEARCH (STRCASE "\\\\") (STRCASE VBAYJ))
)
(setq
VBAYJ
(VL-STRING-SUBST
"\\"
(STRCASE "\\\\")
(STRCASE VBAYJ)
)
)
)
(setq BASTEXT
(APPEND
BASTEXT
(LIST (STRCAT "fhz = " APINAME "(" VBAYJ ")"))
)
)
)
)
(COND ((= CZSX nil)
(setq BASTEXT
(APPEND
BASTEXT
(LIST
"ThisDrawing.SetVariable \"users1\", CStr(fhz)"
)
)
)
)
((= CZSX T)
(setq BASTEXT
(APPEND
BASTEXT
(LIST "ThisDrawing.SetVariable \"users1\", fhz"
)
)
)
)
)
(setq BASTEXT (APPEND BASTEXT (LIST "End Sub")))
(setq APINAME "AutoCadVLispUseVbaWinSystemApi")
)
((= APISM 888) (setq BASTEXT CSLIST))
)
(C:YSX-USE-VBABAS APISM CADVBA BASTEXT APINAME)
(C:YSX-UNLOAD-DVB)
(if (/= (GETVAR "users1") "")
(PROGN
(COND ((= CZSX nil) (setq FHZ (READ (GETVAR "users1"))))
((= CZSX T) (setq FHZ (GETVAR "users1")))
)
)
)
)
)
(MAPCAR 'SETVAR (LIST "cmdecho" "users1") VARLIST)
FHZ
)
(vl-ACAD-defun 'C:YSX-FUNCTION-API)
;;主函数
(SETVAR "cmdecho" 0)
(DEFUN C:YSX-USE-API (CZSX APISM APINAME CSLIST)
(VL-CATCH-ALL-APPLY
'C:YSX-FUNCTION-API
(LIST APISM CZSX CSLIST APINAME)
)
)
;|;以下的函数几本没什么用处
(DEFUN C:QWERTYUIOPASDFGHJKLZXCVBNM9638527410 () T);用来防反编译？？
;;Ysx-Vlisp-WinAPI是此文件编译成VLX后的文件名
;;VL-LIST-EXPORTED-FUNCTIONS 返回vlx中C:定义的函数名列表
(if (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI")
(PROGN
(if
(EQUAL (MAPCAR 'STRCASE
(VL-LIST-EXPORTED-FUNCTIONS "Ysx-Vlisp-WinAPI")
)
(MAPCAR 'STRCASE
(LIST "c:qwertyuiopasdfghjklzxcvbnm9638527410"
"c:ysx-use-api"
)
)
)
nil
(PROGN
(setq C:YSX-USE-API nil)
(setq C:YSX-LOAD-VBA nil)
(setq C:YSX-FUNCTION-API nil)
(setq C:YSX-USE-VBABAS nil)
(setq C:YSX-UNLOAD-DVB nil)
)
)
)
)
(if (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI")
nil
(PROGN
(setq C:YSX-USE-API nil)
(setq C:YSX-LOAD-VBA nil)
(setq C:YSX-FUNCTION-API nil)
(setq C:YSX-USE-VBABAS nil)
(setq C:YSX-UNLOAD-DVB nil)
)
)
|;
(PRINC)

;|<a href="http://bbs.mjtd.com/thread-74063-1-1.html" target="_blank">http://bbs.mjtd.com/thread-74063-1-1.html</a> 
Vlisp直接调用Win API通用函数：c:ysx-use-api by yyzhan12 
参数说明： 
1、参数1 
API返回值类型，long为nil, string为T 
返回值目前仅支持long和string，其他类型的日后完善 
 
2、参数2 
API函数声明，文本 
 
3、参数3 
API函数名称 
 
4、参数4 
API函数参数表 
 
例子： 
(c:ysx-use-api nil "Private Declare Function GetCurrentProcessId Lib \"kernel32\" () As Long" "GetCurrentProcessId" nil) 
获取进程标识符 
 
(c:ysx-use-api nil "Private Declare Function ShowCursor Lib \"user32\" Alias \"ShowCursor\" (ByVal bShow As Long) As Long" "ShowCursor" (list 1)) 
显示鼠标 
 
(c:ysx-use-api nil "Private Declare Function ShowCursor Lib \"user32\" Alias \"ShowCursor\" (ByVal bShow As Long) As Long" "ShowCursor" (list 0)) 
隐藏鼠标 
 
(c:ysx-use-api nil "Private Declare Function CopyFile Lib \"kernel32\" Alias \"CopyFileA\" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long" "CopyFile" (list "c:\\bootfont.bin" "d:\\1.vxd" 0)) 
复制文件 
 
 
____________________________________________________________________________________________ 
Vlisp直接调用Win API函数 
解决了以下几个问题: 
1、解决了AutoCAD退出时提示保存工程的问题。 
2、解决了连续调用API时卸载工程不成功的问题 
3、解决命令行多余信息显示的问题 
4、解决影响其它工程的问题 
5、改进Win API代码的加载方式 
6、加强了程序代码反破解功能 
|; 
 
;;[加载VBA] 如果没有安装VBA，此函数没有用。 
(DEFUN C:YSX-LOAD-VBA () 
  (if 
    (AND (= (MEMBER "acvba.arx" (ARX)) nil) 
         (= (MEMBER "acadvba.arx" (ARX)) nil) 
    ) 
     (PROGN 
       (VL-CATCH-ALL-APPLY 'ARXLOAD (LIST (FINDFILE "acvba.arx"))) 
       (VL-CATCH-ALL-APPLY 'ARXLOAD (LIST (FINDFILE "acadvba.arx"))) 
       (PRINC "\r \n") 
     ) 
  ) 
  (PRINC) 
) 
 
;;[卸载DVB] 
(DEFUN C:YSX-UNLOAD-DVB        (/ FHZ CADOBJ DVBNAME DVBZBJ) 
  (setq FHZ nil) 
  (setq CADOBJ (vlax-get-acad-object)) 
  (setq        DVBNAME 
         (vlax-get (vlax-get (vlax-get CADOBJ 'VBE) 'MAINWINDOW) 
                   'CAPTION 
         ) 
  ) 
  (PRINC "\r                                      \n") 
  (setq DVBZBJ "") 
  (COND        ((VL-STRING-SEARCH (STRCASE "全局") (STRCASE DVBNAME)) 
         (setq DVBZBJ "全局") 
        ) 
        ((VL-STRING-SEARCH (STRCASE "global") (STRCASE DVBNAME)) 
         (setq DVBZBJ "global") 
        ) 
  ) 
  (if (OR (= (STRCASE DVBZBJ) (STRCASE "全局")) 
          (= (STRCASE DVBZBJ) (STRCASE "global")) 
      ) 
    (PROGN (setq DVBNAME (READ (SUBSTR DVBNAME 
                                       (+ (VL-STRING-SEARCH 
                                            (STRCASE DVBZBJ) 
                                            (STRCASE DVBNAME) 
                                          ) 
                                          (+ (STRLEN DVBZBJ) 1) 
                                       ) 
                               ) 
                         ) 
           ) 
           (vlax-invoke-method 
             CADOBJ 
             'UNLOADDVB 
             (CAR (LIST        (STRCAT DVBZBJ (ITOA DVBNAME)) 
                        (vlax-invoke-method 
                          (vlax-get-or-create-object "wscript.shell") 
                          'SENDKEYS 
                          (STRCAT "{N}") 
                        ) 
                  ) 
             ) 
           ) 
           (vlax-invoke-method 
             CADOBJ 
             'UNLOADDVB 
             (STRCAT DVBZBJ (ITOA (+ DVBNAME 1))) 
           ) 
           (setq FHZ T) 
    ) 
  ) 
  FHZ 
) 
(vl-ACAD-defun 'C:YSX-UNLOAD-DVB) 
 
;;[使用VBABAS] 
(DEFUN C:YSX-USE-VBABAS        (APISM CADVBA TEXTLIST VBANAME / WRTEXT DGLIST) 
  (setq WRTEXT "") 
  (FOREACH DGLIST TEXTLIST 
    (if        (= WRTEXT "") 
      (setq WRTEXT DGLIST) 
      (setq WRTEXT (STRCAT WRTEXT "\n" DGLIST)) 
    ) 
  ) 
  (vlax-invoke-method 
    (vlax-get 
      (vlax-get        (vlax-get (vlax-get-acad-object) 'VBE) 
                'SELECTEDVBCOMPONENT 
      ) 
      'CODEMODULE 
    ) 
    'ADDFROMSTRING 
    WRTEXT 
  ) 
  (VL-VBARUN (STRCAT "ThisDrawing." VBANAME)) 
  (PRINC) 
) 
(vl-ACAD-defun 'C:YSX-USE-VBABAS) 
 
;;[API] 
(DEFUN C:YSX-FUNCTION-API (APISM    CZSX     CSLIST   APINAME  / 
                           VARLIST  FHZ             CADOBJ   CADVBA   BASTEXT 
                           VBAYJ    DGLIST 
                          ) 
  (VL-LOAD-COM) 
  (PRINT) 
  (setq VARLIST (MAPCAR 'GETVAR (LIST "cmdecho" "users1"))) 
  (MAPCAR 'SETVAR (LIST "cmdecho" "users1") (LIST 0 "")) 
  (setq FHZ nil) 
  (C:YSX-LOAD-VBA) 
  (if 
    (AND (OR (MEMBER "acvba.arx" (ARX)) (MEMBER "acadvba.arx" (ARX))) 
         (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI") 
    ) 
     (PROGN 
       (setq CADOBJ (vlax-get-acad-object)) 
       (command "_.vbanew") 
       (command "_.vbanew") 
       (setq 
         CADVBA        (vlax-get 
                  (vlax-get (vlax-get CADOBJ 'VBE) 'ACTIVEVBPROJECT) 
                  'VBCOMPONENTS 
                ) 
       ) 
       (COND 
         ((/= APISM 888) 
          (setq        BASTEXT 
                 (APPEND BASTEXT 
                         (LIST APISM 
                               "Sub AutoCadVLispUseVbaWinSystemApi()" 
                               "dim fhz" 
                               "On Error Resume Next" 
                         ) 
                 ) 
          ) 
          (COND 
            ((= CSLIST nil) 
             (setq 
               BASTEXT (APPEND BASTEXT 
                               (LIST (STRCAT "fhz = " APINAME "()")) 
                       ) 
             ) 
            ) 
            ((/= CSLIST nil) 
             (setq VBAYJ "") 
             (FOREACH DGLIST CSLIST 
               (if (= VBAYJ "") 
                 (PROGN (setq VBAYJ (VL-PRIN1-TO-STRING DGLIST))) 
                 (PROGN 
                   (setq 
                     VBAYJ 
                      (STRCAT VBAYJ "," (VL-PRIN1-TO-STRING DGLIST)) 
                   ) 
                 ) 
               ) 
             ) 
             (while 
               (and (VL-STRING-SEARCH (STRCASE "\\\\") (STRCASE VBAYJ)) 
               ) 
                (setq 
                  VBAYJ 
                   (VL-STRING-SUBST 
                     "\\" 
                     (STRCASE "\\\\") 
                     (STRCASE VBAYJ) 
                   ) 
                ) 
             ) 
             (setq BASTEXT 
                    (APPEND 
                      BASTEXT 
                      (LIST (STRCAT "fhz = " APINAME "(" VBAYJ ")")) 
                    ) 
             ) 
            ) 
          ) 
          (COND        ((= CZSX nil) 
                 (setq BASTEXT 
                        (APPEND 
                          BASTEXT 
                          (LIST 
                            "ThisDrawing.SetVariable \"users1\", CStr(fhz)" 
                          ) 
                        ) 
                 ) 
                ) 
                ((= CZSX T) 
                 (setq BASTEXT 
                        (APPEND 
                          BASTEXT 
                          (LIST        "ThisDrawing.SetVariable \"users1\", fhz" 
                          ) 
                        ) 
                 ) 
                ) 
          ) 
          (setq BASTEXT (APPEND BASTEXT (LIST "End Sub"))) 
          (setq APINAME "AutoCadVLispUseVbaWinSystemApi") 
         ) 
         ((= APISM 888) (setq BASTEXT CSLIST)) 
       ) 
       (C:YSX-USE-VBABAS APISM CADVBA BASTEXT APINAME) 
       (C:YSX-UNLOAD-DVB) 
       (if (/= (GETVAR "users1") "") 
         (PROGN 
           (COND ((= CZSX nil) (setq FHZ (READ (GETVAR "users1")))) 
                 ((= CZSX T) (setq FHZ (GETVAR "users1"))) 
           ) 
         ) 
       ) 
     ) 
  ) 
  (MAPCAR 'SETVAR (LIST "cmdecho" "users1") VARLIST) 
  FHZ 
) 
(vl-ACAD-defun 'C:YSX-FUNCTION-API) 
 
;;主函数 
(SETVAR "cmdecho" 0) 
(DEFUN C:YSX-USE-API (CZSX APISM APINAME CSLIST) 
  (VL-CATCH-ALL-APPLY 
    'C:YSX-FUNCTION-API 
    (LIST APISM CZSX CSLIST APINAME) 
  ) 
) 
 
 
 
;|;以下的函数几本没什么用处 
(DEFUN C:QWERTYUIOPASDFGHJKLZXCVBNM9638527410 () T);用来防反编译？？ 
 
;;Ysx-Vlisp-WinAPI是此文件编译成VLX后的文件名 
;;VL-LIST-EXPORTED-FUNCTIONS 返回vlx中C:定义的函数名列表 
(if (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI") 
  (PROGN 
    (if 
      (EQUAL (MAPCAR 'STRCASE 
                     (VL-LIST-EXPORTED-FUNCTIONS "Ysx-Vlisp-WinAPI") 
             ) 
             (MAPCAR 'STRCASE 
                     (LIST "c:qwertyuiopasdfghjklzxcvbnm9638527410" 
                           "c:ysx-use-api" 
                     ) 
             ) 
      ) 
       nil 
       (PROGN 
         (setq C:YSX-USE-API nil) 
         (setq C:YSX-LOAD-VBA nil) 
         (setq C:YSX-FUNCTION-API nil) 
         (setq C:YSX-USE-VBABAS nil) 
         (setq C:YSX-UNLOAD-DVB nil) 
       ) 
    ) 
  ) 
) 
(if (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI") 
  nil 
  (PROGN 
    (setq C:YSX-USE-API nil) 
    (setq C:YSX-LOAD-VBA nil) 
    (setq C:YSX-FUNCTION-API nil) 
    (setq C:YSX-USE-VBABAS nil) 
    (setq C:YSX-UNLOAD-DVB nil) 
  ) 
) 
|; 
(PRINC)

baitang36 · 发表于 2024-7-22 12:25:28

自贡黄明儒发表于 2024-7-19 15:22
一看楼主就是高手，可能都忘记这个程序了。我试了一下，可能公司电脑剪粘板的限制，用不了呀

想试试作者是否已经退出江湖了

yyzhan12 · 发表于 2009-3-5 08:22:00

本帖最后由 yyzhan12 于 2010-12-5 19:30 编辑

Vlisp直接调用Win API通用函数：c:ysx-use-api by yyzhan12

参数说明：

1、参数1

API返回值类型，long为nil, string为T

返回值目前仅支持long和string，其他类型的日后完善

2、参数2

API函数声明，文本

3、参数3

API函数名称

4、参数4

API函数参数表

例子：

(c:ysx-use-api nil "Private Declare Function GetCurrentProcessId Lib \"kernel32\" () As Long" "GetCurrentProcessId" nil)

获取进程标识符

(c:ysx-use-api nil "Private Declare Function ShowCursor Lib \"user32\" Alias \"ShowCursor\" (ByVal bShow As Long) As Long" "ShowCursor" (list 1))

显示鼠标

(c:ysx-use-api nil "Private Declare Function ShowCursor Lib \"user32\" Alias \"ShowCursor\" (ByVal bShow As Long) As Long" "ShowCursor" (list 0))

隐藏鼠标

(c:ysx-use-api nil "Private Declare Function CopyFile Lib \"kernel32\" Alias \"CopyFileA\" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long" "CopyFile" (list "c:\\bootfont.bin" "d:\\1.vxd" 0))

复制文件

____________________________________________________________________________________________

Vlisp直接调用Win API函数

解决了以下几个问题:

1、解决了AutoCAD退出时提示保存工程的问题。

2、解决了连续调用API时卸载工程不成功的问题

3、解决命令行多余信息显示的问题

4、解决影响其它工程的问题

5、改进Win API代码的加载方式

6、加强了程序代码反破解功能

____________________________________________________________________________________________

程序已更新 2009-4-4

nonsmall · 发表于 2009-3-5 08:42:00

本帖最后由作者于 2009-4-16 9:51:20 编辑

不错不错

终于有人明白了呵呵

核心的秘密已经揭晓感兴趣的朋友可以参考研究：

http://www.mjtd.com/BBS/dispbbs.asp?BoardID=3&replyID=115948&id=72145&skin=0

yyzhan12 · 发表于 2009-3-5 13:40:00

nonsmall发表于2009-3-5 8:42:00不错不错终于有人明白了呵呵咱们讨论一下最后关闭AutoCAD的时候会有个是否保存工程的提示另外没有alert的话你这个程序一定会有不好使的情况这几个问题怎么解决?

1、最后关闭AutoCAD的时候会有个是否保存工程的提示

这个暂时没想到怎么解决，这是美中不足，多多少少留下了手尾，明白人一看就知道怎么回事了，我想你的程序之前没放出来是不是有这方面的原因。

2、另外没有alert的话你这个程序一定会有不好使的情况

这个不是问题，这是关于返回值的处理问题，在你帖子我已经提出了几种方法，隐蔽性做到无痕迹最好不过了

3、在你的帖子中给出的提示，可能让不少人做了很多无用功，因为关键语句就是两条，之前也想过这种方法，我想用过VBA的人应该也会

想过，以前用add不成功，就没细想了，不过你的“ VLisp开发小助手”真的很实用。要想用VLISP做扩展，那就要用好vlax-invoke-method

nonsmall · 发表于 2009-3-5 13:53:00

保存的提示我有下面的尝试:

1是程序结束之前把工程保存一下可以做到退出AUTOCAD不提示

(但我没保存成功)

2是程序结束前使用命令VBAUNLOAD但是会弹出提示框询问

(我尝试使用Sendkeys操作该提示框有时可以有时不可奇也怪哉)

我之所以还没放出来因为我抽空在研究Vlx封装VBA窗体这个已经实现了

yyzhan12 · 发表于 2009-3-5 16:15:00

本帖最后由作者于 2009-3-11 21:48:10 编辑

请转至1楼

liminnet · 发表于 2009-3-5 16:30:00

厉害,啊,神啊,无敌啊,NON哥,太厉害啦,

yyzhan12 · 发表于 2009-3-5 16:32:00

本帖最后由作者于 2009-3-5 17:07:56 编辑

nonsmall发表于2009-3-5 13:53:00保存的提示我有下面的尝试:1是程序结束之前把工程保存一下可以做到退出AUTOCAD不提示(但我没保存成功)2是程序结束前使用命令VBAUNLOAD但是会弹出提示框询问(我尝试使用Sendkeys操作该提示框有

Vlx封装VBA窗体，和调用API有何区别？

nonsmall · 发表于 2009-3-5 17:22:00

本帖最后由作者于 2009-3-5 17:24:52 编辑

我已经找出API部分的破解方法了:

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Sub AutoCadVLispUseVbaSystemApi()
msgbox "当前Acad程序的PID(进程标识符)为:" & CStr(GetCurrentProcessId()), vbInformation, "Vlisp调用API函数"
End Sub

yyzhan12 · 发表于 2009-3-5 17:53:00

和你的有什么异同的地方没有？

账号		自动登录	找回密码
密码			注册

[函数] 我也来个VLISP直接调用WIN API函数

本帖子中包含更多资源

评分

本帖子中包含更多资源

本帖子中包含更多资源