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

aicr317

楼主能否留下QQ号码，想请教问题

autodesk

学习.......

skynoon

相当的厉害  

自贡黄明儒

权限太高了   

雨的节奏

看来有必要学习一下vba

nijiea123

晕 权限还不够

电赛加油

  多谢大神分享，学习一下！

cchessbd

这不好吧，花了钱也学习不到知识。。。

baitang36

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)

自贡黄明儒

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

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

1. ;|http://bbs.mjtd.com/thread-74063-1-1.html
   
2. Vlisp直接调用Win API通用函数：c:ysx-use-api by yyzhan12
   
3. 参数说明：
   
4. 1、参数1
   
5. API返回值类型，long为nil, string为T
   
6. 返回值目前仅支持long和string，其他类型的日后完善
   
7. 
   
8. 2、参数2
   
9. API函数声明，文本
   
10. 
    
11. 3、参数3
    
12. API函数名称
    
13. 
    
14. 4、参数4
    
15. API函数参数表
    
16. 
    
17. 例子：
    
18. (c:ysx-use-api nil "Private Declare Function GetCurrentProcessId Lib \"kernel32\" () As Long" "GetCurrentProcessId" nil)
    
19. 获取进程标识符
    
20. 
    
21. (c:ysx-use-api nil "Private Declare Function ShowCursor Lib \"user32\" Alias \"ShowCursor\" (ByVal bShow As Long) As Long" "ShowCursor" (list 1))
    
22. 显示鼠标
    
23. 
    
24. (c:ysx-use-api nil "Private Declare Function ShowCursor Lib \"user32\" Alias \"ShowCursor\" (ByVal bShow As Long) As Long" "ShowCursor" (list 0))
    
25. 隐藏鼠标
    
26. 
    
27. (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))
    
28. 复制文件
    
29. 
    
30. 
    
31. ____________________________________________________________________________________________
    
32. Vlisp直接调用Win API函数
    
33. 解决了以下几个问题:
    
34. 1、解决了AutoCAD退出时提示保存工程的问题。
    
35. 2、解决了连续调用API时卸载工程不成功的问题
    
36. 3、解决命令行多余信息显示的问题
    
37. 4、解决影响其它工程的问题
    
38. 5、改进Win API代码的加载方式
    
39. 6、加强了程序代码反破解功能
    
40. |;
    
41. 
    
42. ;;[加载VBA] 如果没有安装VBA，此函数没有用。
    
43. (DEFUN C:YSX-LOAD-VBA ()
    
44.   (if
    
45.     (AND (= (MEMBER "acvba.arx" (ARX)) nil)
    
46.          (= (MEMBER "acadvba.arx" (ARX)) nil)
    
47.     )
    
48.      (PROGN
    
49.        (VL-CATCH-ALL-APPLY 'ARXLOAD (LIST (FINDFILE "acvba.arx")))
    
50.        (VL-CATCH-ALL-APPLY 'ARXLOAD (LIST (FINDFILE "acadvba.arx")))
    
51.        (PRINC "\r \n")
    
52.      )
    
53.   )
    
54.   (PRINC)
    
55. )
    
56. 
    
57. ;;[卸载DVB]
    
58. (DEFUN C:YSX-UNLOAD-DVB        (/ FHZ CADOBJ DVBNAME DVBZBJ)
    
59.   (setq FHZ nil)
    
60.   (setq CADOBJ (vlax-get-acad-object))
    
61.   (setq        DVBNAME
    
62.          (vlax-get (vlax-get (vlax-get CADOBJ 'VBE) 'MAINWINDOW)
    
63.                    'CAPTION
    
64.          )
    
65.   )
    
66.   (PRINC "\r                                      \n")
    
67.   (setq DVBZBJ "")
    
68.   (COND        ((VL-STRING-SEARCH (STRCASE "全局") (STRCASE DVBNAME))
    
69.          (setq DVBZBJ "全局")
    
70.         )
    
71.         ((VL-STRING-SEARCH (STRCASE "global") (STRCASE DVBNAME))
    
72.          (setq DVBZBJ "global")
    
73.         )
    
74.   )
    
75.   (if (OR (= (STRCASE DVBZBJ) (STRCASE "全局"))
    
76.           (= (STRCASE DVBZBJ) (STRCASE "global"))
    
77.       )
    
78.     (PROGN (setq DVBNAME (READ (SUBSTR DVBNAME
    
79.                                        (+ (VL-STRING-SEARCH
    
80.                                             (STRCASE DVBZBJ)
    
81.                                             (STRCASE DVBNAME)
    
82.                                           )
    
83.                                           (+ (STRLEN DVBZBJ) 1)
    
84.                                        )
    
85.                                )
    
86.                          )
    
87.            )
    
88.            (vlax-invoke-method
    
89.              CADOBJ
    
90.              'UNLOADDVB
    
91.              (CAR (LIST        (STRCAT DVBZBJ (ITOA DVBNAME))
    
92.                         (vlax-invoke-method
    
93.                           (vlax-get-or-create-object "wscript.shell")
    
94.                           'SENDKEYS
    
95.                           (STRCAT "{N}")
    
96.                         )
    
97.                   )
    
98.              )
    
99.            )
    
100.            (vlax-invoke-method
     
101.              CADOBJ
     
102.              'UNLOADDVB
     
103.              (STRCAT DVBZBJ (ITOA (+ DVBNAME 1)))
     
104.            )
     
105.            (setq FHZ T)
     
106.     )
     
107.   )
     
108.   FHZ
     
109. )
     
110. (vl-ACAD-defun 'C:YSX-UNLOAD-DVB)
     
111. 
     
112. ;;[使用VBABAS]
     
113. (DEFUN C:YSX-USE-VBABAS        (APISM CADVBA TEXTLIST VBANAME / WRTEXT DGLIST)
     
114.   (setq WRTEXT "")
     
115.   (FOREACH DGLIST TEXTLIST
     
116.     (if        (= WRTEXT "")
     
117.       (setq WRTEXT DGLIST)
     
118.       (setq WRTEXT (STRCAT WRTEXT "\n" DGLIST))
     
119.     )
     
120.   )
     
121.   (vlax-invoke-method
     
122.     (vlax-get
     
123.       (vlax-get        (vlax-get (vlax-get-acad-object) 'VBE)
     
124.                 'SELECTEDVBCOMPONENT
     
125.       )
     
126.       'CODEMODULE
     
127.     )
     
128.     'ADDFROMSTRING
     
129.     WRTEXT
     
130.   )
     
131.   (VL-VBARUN (STRCAT "ThisDrawing." VBANAME))
     
132.   (PRINC)
     
133. )
     
134. (vl-ACAD-defun 'C:YSX-USE-VBABAS)
     
135. 
     
136. ;;[API]
     
137. (DEFUN C:YSX-FUNCTION-API (APISM    CZSX     CSLIST   APINAME  /
     
138.                            VARLIST  FHZ             CADOBJ   CADVBA   BASTEXT
     
139.                            VBAYJ    DGLIST
     
140.                           )
     
141.   (VL-LOAD-COM)
     
142.   (PRINT)
     
143.   (setq VARLIST (MAPCAR 'GETVAR (LIST "cmdecho" "users1")))
     
144.   (MAPCAR 'SETVAR (LIST "cmdecho" "users1") (LIST 0 ""))
     
145.   (setq FHZ nil)
     
146.   (C:YSX-LOAD-VBA)
     
147.   (if
     
148.     (AND (OR (MEMBER "acvba.arx" (ARX)) (MEMBER "acadvba.arx" (ARX)))
     
149.          (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI")
     
150.     )
     
151.      (PROGN
     
152.        (setq CADOBJ (vlax-get-acad-object))
     
153.        (command "_.vbanew")
     
154.        (command "_.vbanew")
     
155.        (setq
     
156.          CADVBA        (vlax-get
     
157.                   (vlax-get (vlax-get CADOBJ 'VBE) 'ACTIVEVBPROJECT)
     
158.                   'VBCOMPONENTS
     
159.                 )
     
160.        )
     
161.        (COND
     
162.          ((/= APISM 888)
     
163.           (setq        BASTEXT
     
164.                  (APPEND BASTEXT
     
165.                          (LIST APISM
     
166.                                "Sub AutoCadVLispUseVbaWinSystemApi()"
     
167.                                "dim fhz"
     
168.                                "On Error Resume Next"
     
169.                          )
     
170.                  )
     
171.           )
     
172.           (COND
     
173.             ((= CSLIST nil)
     
174.              (setq
     
175.                BASTEXT (APPEND BASTEXT
     
176.                                (LIST (STRCAT "fhz = " APINAME "()"))
     
177.                        )
     
178.              )
     
179.             )
     
180.             ((/= CSLIST nil)
     
181.              (setq VBAYJ "")
     
182.              (FOREACH DGLIST CSLIST
     
183.                (if (= VBAYJ "")
     
184.                  (PROGN (setq VBAYJ (VL-PRIN1-TO-STRING DGLIST)))
     
185.                  (PROGN
     
186.                    (setq
     
187.                      VBAYJ
     
188.                       (STRCAT VBAYJ "," (VL-PRIN1-TO-STRING DGLIST))
     
189.                    )
     
190.                  )
     
191.                )
     
192.              )
     
193.              (while
     
194.                (and (VL-STRING-SEARCH (STRCASE "\\\\") (STRCASE VBAYJ))
     
195.                )
     
196.                 (setq
     
197.                   VBAYJ
     
198.                    (VL-STRING-SUBST
     
199.                      "\\"
     
200.                      (STRCASE "\\\\")
     
201.                      (STRCASE VBAYJ)
     
202.                    )
     
203.                 )
     
204.              )
     
205.              (setq BASTEXT
     
206.                     (APPEND
     
207.                       BASTEXT
     
208.                       (LIST (STRCAT "fhz = " APINAME "(" VBAYJ ")"))
     
209.                     )
     
210.              )
     
211.             )
     
212.           )
     
213.           (COND        ((= CZSX nil)
     
214.                  (setq BASTEXT
     
215.                         (APPEND
     
216.                           BASTEXT
     
217.                           (LIST
     
218.                             "ThisDrawing.SetVariable \"users1\", CStr(fhz)"
     
219.                           )
     
220.                         )
     
221.                  )
     
222.                 )
     
223.                 ((= CZSX T)
     
224.                  (setq BASTEXT
     
225.                         (APPEND
     
226.                           BASTEXT
     
227.                           (LIST        "ThisDrawing.SetVariable \"users1\", fhz"
     
228.                           )
     
229.                         )
     
230.                  )
     
231.                 )
     
232.           )
     
233.           (setq BASTEXT (APPEND BASTEXT (LIST "End Sub")))
     
234.           (setq APINAME "AutoCadVLispUseVbaWinSystemApi")
     
235.          )
     
236.          ((= APISM 888) (setq BASTEXT CSLIST))
     
237.        )
     
238.        (C:YSX-USE-VBABAS APISM CADVBA BASTEXT APINAME)
     
239.        (C:YSX-UNLOAD-DVB)
     
240.        (if (/= (GETVAR "users1") "")
     
241.          (PROGN
     
242.            (COND ((= CZSX nil) (setq FHZ (READ (GETVAR "users1"))))
     
243.                  ((= CZSX T) (setq FHZ (GETVAR "users1")))
     
244.            )
     
245.          )
     
246.        )
     
247.      )
     
248.   )
     
249.   (MAPCAR 'SETVAR (LIST "cmdecho" "users1") VARLIST)
     
250.   FHZ
     
251. )
     
252. (vl-ACAD-defun 'C:YSX-FUNCTION-API)
     
253. 
     
254. ;;主函数
     
255. (SETVAR "cmdecho" 0)
     
256. (DEFUN C:YSX-USE-API (CZSX APISM APINAME CSLIST)
     
257.   (VL-CATCH-ALL-APPLY
     
258.     'C:YSX-FUNCTION-API
     
259.     (LIST APISM CZSX CSLIST APINAME)
     
260.   )
     
261. )
     
262. 
     
263. 
     
264. 
     
265. ;|;以下的函数几本没什么用处
     
266. (DEFUN C:QWERTYUIOPASDFGHJKLZXCVBNM9638527410 () T);用来防反编译？？
     
267. 
     
268. ;;Ysx-Vlisp-WinAPI是此文件编译成VLX后的文件名
     
269. ;;VL-LIST-EXPORTED-FUNCTIONS 返回vlx中C:定义的函数名列表
     
270. (if (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI")
     
271.   (PROGN
     
272.     (if
     
273.       (EQUAL (MAPCAR 'STRCASE
     
274.                      (VL-LIST-EXPORTED-FUNCTIONS "Ysx-Vlisp-WinAPI")
     
275.              )
     
276.              (MAPCAR 'STRCASE
     
277.                      (LIST "c:qwertyuiopasdfghjklzxcvbnm9638527410"
     
278.                            "c:ysx-use-api"
     
279.                      )
     
280.              )
     
281.       )
     
282.        nil
     
283.        (PROGN
     
284.          (setq C:YSX-USE-API nil)
     
285.          (setq C:YSX-LOAD-VBA nil)
     
286.          (setq C:YSX-FUNCTION-API nil)
     
287.          (setq C:YSX-USE-VBABAS nil)
     
288.          (setq C:YSX-UNLOAD-DVB nil)
     
289.        )
     
290.     )
     
291.   )
     
292. )
     
293. (if (VL-VLX-LOADED-P "Ysx-Vlisp-WinAPI")
     
294.   nil
     
295.   (PROGN
     
296.     (setq C:YSX-USE-API nil)
     
297.     (setq C:YSX-LOAD-VBA nil)
     
298.     (setq C:YSX-FUNCTION-API nil)
     
299.     (setq C:YSX-USE-VBABAS nil)
     
300.     (setq C:YSX-UNLOAD-DVB nil)
     
301.   )
     
302. )
     
303. |;
     
304. (PRINC)

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