卸载.vlx程序

Lisphk

/db_自贡黄明儒_ 发表于 2016-12-29 08:30

2014以上版本加的安全路径

系统变量，得到值后，删除掉你想的路径，然后再写回去就行了吧

/db_自贡黄明儒_

第一件事情是注册表，老外写的，不过我说有试过（有谁试过的，请告诉我)

(defun RemoveFromStartupSuite (filename   /          Default
                               File_List  Fn         Index
                               Regpath    Revision   Startuppath
                               Version
                              )
  ;; codeHimBelonga kdub 2010.11.27
  ;;
  (setq Regpath     "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD"
        revision    (vl-registry-read regpath "CurVer")
        version     (vl-registry-read
                      (setq regpath (strcat regpath "\\" revision))
                      "CurVer"
                    )
        default     (vl-registry-read
                      (setq
                        regpath (strcat regpath "\\" version "\\Profiles")
                      )
                    )
        startupPath (strcat regpath
                            "\\"
                            default
                            "\\Dialogs\\Appload\\Startup"
                    )
        index       0
        file_list   '()
  )
  (while (setq fn (vl-registry-read
                    startupPath
                    (strcat (itoa (setq index (1+ index))) "Startup")
                  )
         )
    (setq file_list (cons fn file_list))
  )
  (setq index    0
        filename (strcase filename)
  )
  (vl-registry-delete startupPath)
  (vl-registry-write startupPath)
  (foreach entry (reverse file_list)
    (if (not (vl-string-search FileName (strcase entry)))
      (progn (vl-registry-write
               startupPath
               (strcat (itoa (setq index (1+ index))) "Startup")
               entry
             )
             (vl-registry-write startupPath "NumStartup" (itoa index))
      )
    )
  )
  (setq index 0
        file_list '()
  )
  (while (setq fn (vl-registry-read
                    startupPath
                    (strcat (itoa (setq index (1+ index))) "Startup")
                  )
         )
    (setq file_list (cons fn file_list))
  )
)

ll_j

明显的强迫症，想事情不知道回旋，VLX是Lisp打包文件，加载是Lisp定义的命令，而Lisp是无法卸载的，只能用nil值取冲，那么问题不就可以换一个角度考虑了吗？
到底这个VLX加载了那些Lisp函数或命令，想知道这个答案也是很有难度的，但要比明知VLX不能卸载而一定要去卸载更靠谱吧？
再说，好好的程序，你不想用的话，不加载就是，干嘛费劲巴拉得去卸载？

zhangq_cai1

太高深了~~~~~~~~~~~~~~~~~~~~~~~~~~·

/db_自贡黄明儒_

ll_j 发表于 2016-12-29 12:06

先抛开强迫症不说，比如你用了一个.vlx，加入了启动组，_appload又卸不了，现在不想用了（比如发现不好用)。就得从注册表中卸载。那个老外的程序我试过了，是可以的。
长老是不是认为我在讲没有加入启动组的vlx。如果没有加入启动组，直接删除就得了。

elitefish

将7Xin_Manager.vlx添加到acaddoc.lsp中
当程序被删除时，自动删除注册表并从acaddoc.lsp中删除相关代码，再删除添加的搜索目录


(defun 7Xin:AddStartup ( / sFile fLisp bFind sLine lstLine AddToRun
            )
  (setq str
     '(if (and (setq sPath (vl-registry-read "HKEY_CURRENT_USER\\Software\\7Xin" "7Xin_ManagerPath"))
           (setq sPath (vl-string-right-trim "\\" sPath))
           (findfile (strcat sPath "\\7XIN_MANAGER.VLX"))
           )
       (progn
        (load (strcat sPath "\\7XIN_MANAGER.VLX"))
        (setq sPath nil)
        (princ)
        )
       (progn
        (vl-registry-delete "HKEY_CURRENT_USER\\Software\\7Xin")
        (if sPath
         (progn
          (setq sSupport (getenv "ACAD"))
          (setq lenSource (strlen sSupport)
           )
          (while (setq iPos (vl-string-search ";" sSupport))
           (setq lstPath (cons (substr sSupport 1 iPos) lstPath)
        sSupport (substr sSupport (+ 2 iPos))
        )
           )
          (setq lstPath (reverse (cons sSupport lstPath)))
          (setq lstPath (vl-remove-if '(lambda (e) (wcmatch (strcase e) (strcat sPath "*"))) lstPath))
          (setq sPath (car lstPath)
           lstPath (cdr lstPath)
           )
          (foreach str lstPath
           (setq sPath (strcat sPath ";" str))
           )
          (setenv "ACAD" sPath)
          )
         )
        (setq fLisp (open (findfile acadlsp) "r"))
        (while (setq sLine (read-line fLisp))
         (if (wcmatch (strcase sLine) "*7XIN_MANAGER*")
          (if (= (car lstLine) "") (setq lstLine (cdr lstLine)))
          (setq lstLine (cons sLine lstLine))
          )
         )
        (close fLisp)
        (if (setq fLisp (open (findfile acadlsp) "w"))
         (progn
          (mapcar '(lambda (sLine) (write-line sLine fLisp)) (reverse lstLine))
          (close fLisp)
          (alert "[[信·CAD]]已被删除，程序自动卸载！系统无残留！")
          )
         (progn
          (alert (strcat acadlsp " 被设为只读或正被其他程序打开\n程序无法自动卸载"))
          (startapp "explorer" (strcat " /select," (findfile acadlsp)))
          )
         )
        (setq fLisp nil sPath nil sLine nil lstLine nil sPath nil lstPath nil sSupport nil str nil)
        (princ)
        )
       )
    )

  (defun AddToRun (sFile / file)
    (if (setq file (7Xin:Open sFile "w"))
      (progn
    (princ "(setq acadlsp \"" file)
    (princ acadlsp file)
    (princ "\")" file)
    (prin1 str file)
    (write-line "" file)
    (mapcar '(lambda (sLine) (write-line sLine file)) (reverse lstLine) )
    (close file)
    T
    )
      (progn
    (7Xin:Attrib-Write sFile)
    (if (setq fLisp (7Xin:Open sFile "w"))
      (progn
        (princ "(setq acadlsp \"" file)
        (princ acadlsp file)
        (princ "\")" file)
        (prin1 str fLisp)
        (write-line "" fLisp)
        (mapcar '(lambda (sLine) (write-line sLine fLisp)) (reverse lstLine) )
        (close fLisp)
        (7Xin:Attrib-ReadOnly sFile)
        T
        )
      )
    )
      )
    )

  
  (if (and (setq sFile (findfile acadlsp))
       (setq fLisp (7Xin:Open sFile "r"))
       )
    (progn
      (while (and (not bFind) (setq sLine (read-line fLisp)))
    (cond ((and (wcmatch (strcase sLine) "*7XIN_MANAGER*") (wcmatch (strcase sLine) "*AUTODESK*")))
          ((and (wcmatch (strcase sLine) "*7XIN_MANAGER*") (not (wcmatch (strcase sLine) "*AUTODESK*")))
           (setq bFind T)
           )
          (T
           (setq lstLine (cons sLine lstLine))
           )
          )
    )
      (close fLisp)
      )
    )

  (cond (bFind)
    ((and acadlsp (/= acadlsp "") (not (findfile acadlsp))) (AddToRun (strcat 7Xin::Path "\\" acadlsp)))
    ((findfile acadlsp) (AddToRun (findfile acadlsp)))
    (T (7Xin:AddStartApp (strcat 7Xin::Path "\\7Xin_Manager.VLX")))
    )
  )

/db_自贡黄明儒_

elitefish 发表于 2016-12-29 13:56

你的强迫症比我严重，我的很简单。

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;VLX程序卸载 By 自贡黄明儒2016.12.29
(VL-LOAD-com)
(defun C:MyUnload ()
  (if (menugroup "CXinZhi")
    (command "menuunload" "CXinZhi")        ;不能带后缀
  )
  (vl-file-delete "acad.lsp")
  (if (vl-catch-all-error-p
        (vl-catch-all-apply 'vl-unload-vlx (list "HH"))
      )                                        ;不能带后缀
    (vl-catch-all-apply 'DelToStartupSuite (list "HH"))
  )
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   VLX程序卸载

;;从启动组删除HH.VLX
;;示例(DelToStartupSuite "HH")
(defun DelToStartupSuite (filename / CT DEFAULT N NUMSTARTUP REGPATH REVISION VERSION)
  (setq        regpath         "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD"
        revision (vl-registry-read regpath "CurVer")
        version         (vl-registry-read
                   (setq regpath (strcat regpath "\\" revision))
                   "CurVer"
                 )
        default         (vl-registry-read
                   (setq
                     regpath (strcat regpath "\\" version "\\Profiles")
                   )
                 )
        regpath         (strcat regpath
                         "\\"
                         default
                         "\\Dialogs\\Appload\\Startup"
                 )
        ct         1
  )
  (if (setq numstartup (vl-registry-read regpath "NumStartup"))
    (progn
      (setq n (1+ (atoi numstartup)))
      (while
        (and
          (< ct n)
          (/= filename
              (cadr
                (fnsplitl
                  (vl-registry-read regpath (strcat (itoa ct) "Startup"))
                )
              )
          )
        )
         (setq ct (1+ ct))
      )
    )
  )
  (vl-registry-delete regpath (strcat (itoa ct) "Startup"))
  (vl-registry-delete regpath "NumStartup" (itoa ct))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;VLX程序卸载 By 自贡黄明儒2016.12.29