[LISP程序]：SORRY 30 DAY TRIAL IS OVER

linshucai

;erases an old text entity
;simple but effective routine by ken melvin

(defun c:ET ( / expl newen newlist newtext xx elist oldtxt oldlist)
(sETVAR "CMDECHO" 0)
;********ERROR HANDLER**********************
(defun *Error* (msg)
  (if (/= msg "Function cancelled")
    (princ (strcat "\nError: " msg))
  )
(terpri)
                        
  (setq *error* olderr)        
  (princ)
)
;***********************************************
(check)
(if cont (exit))
(setq expl (entsel "\nSelect text to replace:"))
(setq xx (car expl))
(setq elist (entget xx))
(setq oldtxt (assoc 1 elist))
(setq oldlist (list oldtxt))

(setq lists (list (cons 0 "TEXT") oldtxt))

(setq allents (ssget "X" lists))
(setq n 0)
(setq ent (ssname allents 0))
(while ent
(command "erase" ent "")
(setq n (1+ n))
(setq ent (ssname allents n))
)
(princ)
);end funct
;********************PASSWORD************************************
(defun date ()
        (setq td (getvar "date"))
        (setq time (* 86400.0 (- td (setq j (fix td)))))
        (setq j (- j 1721119.0))
        (setq y (fix (/ (1- (* 4 j)) 146097.0)))
        (setq j (- (* j 4.0) 1.0 (* 146097.0 y)))
        (setq d (fix (/ j 4.0)))
        (setq j (fix (/ (+ (* 4.0 d) 3.0) 1461.0)))
        (setq d (- (+ (* 4.0 d) 3.0) (* 1461.0 j)))
        (setq d (fix (/ (+ d 4.0) 4.0)))
        (setq m (fix (/ (- (* 5.0 d) 3) 153.0)))
        (setq d (- (* 5.0 d) 3.0 (* 153.0 m)))
        (setq d (fix (/ (+ d 5.0) 5.0)))
        (setq y (+ (* 100.0 y) j))
        (if (< m 10.0)
                (setq m (+ m 3))
                (progn       
                        (setq m (- m 9))
                        (setq y (1+ y))
                )
        )

; Now print the date. Year in Y, month in M, day in D

        (setq year  (rtos (fix y) 2 0))
        (setq month (rtos (fix m) 2 0))
        (setq day   (rtos (fix d) 2 0))
);end

;**************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun check (/ lname logg loggo logname pass_chek)
(setq cont nil)
(find_Dcl)
(date)
(setq lname (getvar "loginname"))
(if (not lname)(setq lname ""))
(setq logg (open (strcat path "\\liscense.lib") "r"))
(if (= logg nil)
(progn
(setq loggo (open (strcat path "\\liscense.lib") "w"))
(write-line lname loggo)
(write-line year  loggo)
(write-line month loggo)
(write-line day loggo)
(close loggo)
(setq logg (open (strcat path "\\liscense.lib") "r"))
));end if/progn
(setq logname (read-line logg))
(setq ryear (read-line logg))
(setq ryear (atoi ryear))
(setq rmonth (read-line logg))
(setq rmonth (atoi rmonth))
(setq rday (read-line logg))
(setq rday (atoi rday))
(setq passm (read-line logg))
    (while passm
      (if (= (STRCASE passm) "ERASETXT")
          (progn
          (setq PASS_chek 1)
          (setq passm nil)
          )
          (progn     
          (setq passm (read-line logg))
      ));end progn/if
     );end while
(close logg)
(if (= PASS_chek 1)(setq passm "ERASETXT")(setq passm "shit"))
(if (/= (strcase passm) "ERASETXT")
(progn
(if (/= lname logname)
(progn
(alert "\nSORRY YOU ARE NOT AN APPROVED USER OF THIS RELEASE")
(alert (strcat "\nREGISTER! " lname"."))
(setq cont 0)
));end if/progn
(if (< ryear (atoi year))
(progn
(alert "\nSORRY 30 DAY TRIAL IS OVER!")
(alert (strcat "\nREGISTER!" LNAME "."))
(setq cont 0)
));end if/progn
(if (and (< rmonth (atoi month))(< rday (atoi day)))
(progn
(alert "\nSORRY 30 DAY TRIAL IS OVER!")
(alert (strcat "\nREGISTER!" LNAME "."))
(setq cont 0)
));end if/progn
(if (< (+ 2 rmonth) (atoi month))
(progn
(alert "\nSORRY 60 DAY TRIAL IS OVER!\nThat's right I gave you 60 days!")
(alert (strcat "\nREGISTER!" LNAME "."))
(setq cont 0)
));end if/progn

(if (= cont 0)
(pasw))
));end first if/progn
(princ)
);end check
;***********************************************************
(defun Pasw ()
(setq xpass (getstring "Please enter the valid password: "))
(if (/= (strcase xpass) "ERASETXT")
(setq xpass (getstring "Invalid, try again: ")))
(if (/= (strcase xpass) "ERASETXT")
(setq xpass (getstring "Invalid, last try: ")))
(if (= (strcase xpass) "ERASETXT")
(progn
(setq loggo (open (strcat path "\\liscense.lib") "a"))
(write-line "ERASETXT" loggo)
(alert "Thank you for registering!")
(close loggo)
(setq loggo (open "c:\\acad.llb" "a"))
(write-line "ETXT.LSP" loggo)
(close loggo)
(setq cont nil)
)(alert (strcat "\Why guess " lname " just register!")));end progn/if
(princ)
);end pasw
;*************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;********************Path setting************************************
(defun find_Dcl ()
(Setq datafile (findfile "c:\\lisp_lib.ini"))
(if (not datafile)(alert "Could not find configuration settings for the lisp_lib, attempting to load from defaults")
            (progn
            (setq FILEVAR (open datafile "r"))
(repeat 3 (read-line filevar))
(setq PATH (read-line filevar))
));end progn/it
)
;*******************
(princ "\nETXT-erases text by selection-type ET")
(princ)

sfjlx

这是干什么的啊!有没说明?