[编程交流] acad病毒

;;; KillWorm, Mehrdad Ahankhah, [url="http://www.irancad.com"]www.irancad.com[/url]
(setq KillWormVersion 1.42)
(setq KillWormDate "2011/01/04")
(defun C:KW (/ cont kw)
(setvar 'Cmdecho 0)
(command "_.LOGFILEOFF")
(command "_.LOGFILEON")
(setq cont T)
(while cont
(setq cont nil)
(initget "Active Passive ALL Select ? _Active Passive ALL Select ?")
(setq kw (getkword "\nSelect option [Active/Passive/ALL/Select/?]: "))
(cond
((= kw "Active") (C:KillActiveWorm))
((= kw "Passive") (C:KillPassiveWorm))
((= kw "ALL") (C:KillWormCompletely))
((= kw "Select") (C:KillWormSelectedDir))
((= kw "?")
(textscr)
(princ
(strcat
"
Options:
Active: Kill worm in the AutoCAD environment, if the worm is active.
Passive: Kill worm in the AutoCAD environment, even if the worm isn't active.
ALL: Kill worm in all drives.
Select: Kill worm in selected folder.
?: Help")
)
(setq cont T)
)
)
)
(command "_.LOGFILEOFF")
(setvar 'Cmdecho 1)
(princ)
)
(defun C:KillActiveWorm ()
(if (MT-WormExists)
(C:KillPassiveWorm)
(princ "\nNo worm found, aborting...")
)
(princ)
)
(defun C:KillPassiveWorm (/ FilesList)
(MT-KillWormSources)
(setq FileList (MT-FindLispFiles))
(foreach lsp FileList (MT-KillWorm lsp))
(princ)
)
(defun C:KillWormCompletely (/ FilesList) (MT-KillWormOnDrives) (princ))
(defun C:KillWormSelectedDir () (MT-KillWormOnDirs (MT-GetFolder)) (princ))
(defun MT-KillWormSources (/ found)
(foreach Worm '("acad.vlx" "logo.gif")
(while (setq found (findfile Worm))
(princ (strcat (if (vl-file-delete found)
"\nFile deleted successfully: ""
"\nError occured while deleting file: ""
)
found
"""
)
)
)
)
)

(defun MT-KillWormOnDrives ()
   (foreach drive (MT-ValidDrives) (MT-KillWormOnDirs (strcat drive ":\")))
)
(defun MT-GetFolder (/ DirPat)
   ;;(and
       (setq DirPat (getfiled "Browse for folder"
                               "Select a file in your desired folder"
                              ;;"Open a folder and click on SAVE"
                               ""
                               16
                     )
        )
        ;;(setq DirPat (substr DirPat 1 (- (strlen DirPat) 31)))
   ;
   (vl-filename-directory DirPat)
)
(defun MT-ValidDrives (/ firstdrive lastdrive n drive drives)
   (princ "\nFinding valid local drives, please wait... Found: ")
   (setq firstdrive (ascii "a"))
   (setq lastdrive (ascii "z"))
   (setq n (1- firstdrive))
   (setq drives nil)
   (repeat (- lastdrive n)
       (princ "_")
       (setq drive (chr (setq n (1+ n))))
       (if (findfile (strcat drive ":\\."))
           (progn (setq drives (append (list drive) drives)) (princ drive))
           (princ ".")
       )
   )
   (reverse drives)
)
(defun MT-KillWormOnDirs (dir / worm1 worm2 kill-it subdir)
   ;;(setq dir "q:\"); ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (princ (strcat "\nSearching: "" dir """))
   (setq worm1 "acad.vlx")
   (setq worm2 "logo.gif")
   (if (vl-directory-files dir worm2 1)
       (progn
           (if (vl-directory-files dir worm1 1)
               (foreach worm (list worm1 worm2)
                   (princ
                       (strcat
                           (if (vl-file-delete (setq kill-it (strcat dir worm))
                               )  "\nFile deleted successfully: ""
                                  "\nError occured while deleting file: ""
                           )
                           kill-it
                           """
                       )
                   )
               )
               (progn (princ (strcat "\nFound but not deleted: ""
                                     dir
                                     worm2
                                     ""\nPlease check and delete it manually."
                             )
                      )
               )
           )
       )
   )
   (foreach lsp '("*.lsp" "*.mnl")
       (foreach lsp1 (vl-directory-files dir lsp 1)
           (print lsp1)
           (MT-KillWorm (strcat dir lsp1))
       )
   )
   (foreach subdir (vl-directory-files dir nil -1)
       (if (not (member subdir '("." "..")))
           (MT-KillWormOnDirs (strcat dir subdir "\"))
       )
   )
)
(defun MT-FindLispFiles (/ MT-BindDir fileslist found filepath)
   ;; search in search path: acadprefix
   ;; ACETAUTO.LSP, AI_UTILS.LSP, and ACAD.MNL
   (defun MT-BindDir (file) (findfile (strcat filepath "\" file)))
   (setq filelist nil)
   (if (and (setq found (findfile "acad.mnl"))
            (setq filepath (vl-filename-directory found))
       )
       (setq filelist (append (mapcar 'MT-BindDir
                                      (vl-directory-files filepath "*.mnl")
                              )
                              filelist
                      )
       )
   )
   (if (and (setq found (findfile "acad.exe"))
            (setq filepath (strcat (vl-filename-directory found) "[url="file://support/"]\\support[/url]"))
       )
       (setq filelist (append (mapcar 'MT-BindDir
                                      (vl-directory-files filepath "*.lsp")
                              )
                              filelist
                      )
       )
   )
   (if (setq filepath (strcat (getvar 'Roamablerootprefix) "support"))
       (setq filelist (append (mapcar 'MT-BindDir
                                      (vl-directory-files filepath "*.lsp")
                              )
                              filelist
                      )
       )
   )
   (if (setq found (findfile "acaddoc.lsp"))
       (if (not (member found filelist))
           (setq filelist (append (list found) filelist))
       )
   )
   (if (and (setq found (findfile (getvar "dwgname")))
            (setq found
                     (findfile
                         (strcat (vl-filename-directory found) "[url="file://acaddoc.lsp/"]\\acaddoc.lsp[/url]")
                     )
            )
       )
       (if (not (member found filelist))
           (setq filelist (append (list found) filelist))
       )
   )
   filelist
)
(defun MT-WormExists ()
   (if (and (= flagx T) (= bz "(setq flagx t)"))
       T
       nil
   )
)
(defun MT-KillWorm
      (lsp / row lspfile cont WormFound line-read newlsp newlspfile)
   ;; delete all instances of: ACAD.VLX and LOGO.GIF
   ;; clean all instances of: ACETAUTO.LSP, AI_UTILS.LSP, and ACAD.MNL 
   ;; The acad.vlx file creates a copy of itself in the Help folder (for example, C:\Program Files\AutoCAD 20xx\Help\logo.gif). 
   (if (findfile lsp)
       (progn
           (setq row 0)
           (if (setq lspfile (open lsp "r"))
               (progn
                   (setq cont T)
                   (setq WormFound nil)
                   (while (and cont (setq line-read (read-line lspfile)))
                       (cond
                           ((and (= line-read "AutoCAD PROTECTED LISP file")
                                 (null (read-line lspfile))
                            )
                            (princ (strcat "Ignored protected lisp file: ""
                                           lsp
                                           """
                                   )
                            )
                            (setq cont nil)
                           )
                           ((= line-read "(setq flagx t)")
                            (if (not (or (= "" last-line-read)
                                         (= (setq
                                                line-read (read-line lspfile)
                                            )
                                            "(setq bz "(setq flagx t)")"
                                         )
                                     )
                                )
                                (princ
                                    (strcat
                                        "An unpredictable condition occured in: ""
                                        lsp
                                        "" file. It shouldn't occure!"
                                    )
                                )
                            )
                            (setq WormFound T)
                            (setq cont nil)
                           )
                           (T (setq row (1+ row)))
                       )
                       (setq last-line-read line-read)
                   )                             ; while
                   (setq lspfile (close lspfile))
                   (if WormFound
                       (progn
                           (if (= 1 row)
                               (progn
                                   (if (vl-file-delete lsp)
                                       (princ
                                           (strcat
                                               "\nFile deleted successfully: ""
                                               lsp
                                               """
                                           )
                                       )
                                       (princ
                                           (strcat
                                               "\nError occured deleting file: ""
                                               lsp
                                               """
                                           )
                                       )
                                   )
                               )
                               (progn
                                   (setq newlsp (strcat lsp ".mehretaban"))
                                   (if (and (setq lspfile (open lsp "r"))
                                            (setq newlspfile (open newlsp "w"))
                                       )  (progn
                                              (repeat row
                                                  (princ (read-line lspfile)
                                                         newlspfile
                                                  )
                                                  (princ "\n" newlspfile)
                                              )
                                              (princ
                                                  (strcat
                                                      "\n;|\nFile cleaned successfully by KillWorm "
                                                      (vl-princ-to-string
                                                          KillWormVersion
                                                      )
                                                      " - "
                                                      KillWormDate
                                                      " (Mehrdad Ahankhah, Mahbad Consulting Co, [url="http://www.irancad.com/"]www.irancad.com[/url])"
                                                  )
                                                  newlspfile
                                              )
                                              (setq lspfile (close lspfile))
                                              (setq newlspfile (close newlspfile))
                                              (if (and (vl-file-delete lsp)
                                                       (vl-file-rename newlsp lsp)
                                                  )  (princ
                                                         (strcat
                                                             "\nFile cleaned successfully: ""
                                                             lsp
                                                             """
                                                         )
                                                     )
                                                     (princ
                                                         (strcat
                                                             "\nError occured cleaning file: ""
                                                             lsp
                                                             """
                                                         )
                                                     )
                                              )
                                          )
                                          (progn
                                              (if lspfile
                                                  (setq lspfile (close lspfile))
                                                  (princ
                                                      (strcat
                                                          "\nError occured opening file to read: ""
                                                          lsp
                                                          """
                                                      )
                                                  )
                                              )
                                              (if newlspfile
                                                  (setq newlspfile
                                                           (close newlspfile
                                                           )
                                                  )
                                                  (princ
                                                      (strcat
                                                          "\nError occured opening file to write: ""
                                                          newlsp
                                                          """
                                                      )
                                                  )
                                              )
                                          )
                                   )
                               )
                           )
                       )
                       (princ (strcat "\nFile is already clean: "" lsp """))
                   )
               )
               (progn (princ (strcat "\nError occured opening file for read: ""
                                     lsp
                                     """
                             )
                      )
               )
           )                                     ; if
       )
       (progn (princ (strcat "Warning: ""
                             lsp
                             "" file not found. It shouldn't occure!"
                     )
              )
       )
   )                                             ; if
)
(setq msg
        (strcat
            "\nKillWorm, a program to kill ACAD.LSP and ACADDOC.LSP worm, version "
            (vl-princ-to-string KillWormVersion)
            " - "
            KillWormDate
            "\n\nDesigned by Mehrdad Ahankhah, Mahbad Consulting Co"
            "\n\nVisit: [url="http://www.irancad.com/"]www.irancad.com[/url]"
            "\n\n\n\nEnter 'KW' to run the command."
        )
)
(alert msg)
(princ msg)