[LISP]Create a windows shortcut
;;Create a windows shortcut
;;MODIFY BY 龙龙仔(LUCAS)
;;FIL = file name must have extension .lnk
;;CDIR = shortcut存于目录(目录不存在会出错)
;;TARGET = 执行档案
;;LST = DESCRIPTION
;;WDIR = WORKINGDIRECTORY
;;TAG = to overwrite it T OR NIL
;;(F:WINDOWS_SHORTCUT"CDCHECK.LNK" "C:\\LSP" "C:\\Cdcheck\\CDCheck.exe" '("CDCHECK") "C:\\LSP" T)
(defun F:WINDOWS_SHORTCUT
(FIL CDIR TARGET LST WDIR TAG / WSH LNK RET COMMENT)
(setq FIL (strcat CDIR "\\" FIL))
(if (or (and (findfile FIL) TAG) (not (findfile FIL))) ;or
(progn (setq WSH (vlax-create-object "Wscript.Shell")
LNK (vlax-invoke-method WSH 'CREATESHORTCUT FIL)
) ;setq
(if (not (setq COMMENT (car LST)))
(setq COMMENT "")
)
(if (and (F:VLERR 'vlax-put-property
(list WSH 'CURRENTDIRECTORY CDIR)
NIL
)
(F:VLERR 'vlax-put-property
(list LNK 'TARGETPATH TARGET)
NIL
)
(F:VLERR 'vlax-put-property
(list LNK 'DESCRIPTION COMMENT)
NIL
)
(F:VLERR 'vlax-put-property
(list LNK 'WORKINGDIRECTORY WDIR)
NIL
)
(F:VLERR 'vlax-invoke-method (list LNK 'SAVE) NIL)
) ;and
(progn (mapcar 'vlax-release-object (list WSH LNK))
(setq RET t)
) ;progn
) ;if
) ;progn
) ;if
RET
)
;;return the target path of a windows shortcut file (.lnk)
;;(F:GET_WINDOWS_SHORTCUT_PROPERTIES "cdcheck.lnk")
(defun F:GET_WINDOWS_SHORTCUT_PROPERTIES (FIL / WSH LNK PTH COM)
(if (setq FIL (findfile FIL))
(progn (setq WSH (vlax-create-object "Wscript.Shell")
LNK (vlax-invoke-method WSH 'CREATESHORTCUT FIL)
PTH (vlax-get-property LNK 'TARGETPATH)
COM (vlax-get-property LNK 'DESCRIPTION)
) ;setq
(mapcar 'vlax-release-object (list WSH LNK))
)
)
(if PTH
(list PTH COM)
NIL
)
)
;;simplified error catching routine for vl-catch*
;;usage (setq en (f:vlerr 'vla-get-Area (list en) nil))
;;tag = true for debugging: princes error message
(defun F:VLERR (FUN LST TAG / RET)
(if (vl-catch-all-error-p
(setq RET (vl-catch-all-apply FUN LST))
)
(if TAG
(progn (princ (vl-catch-all-error-message RET)) NIL)
NIL
)
(if (not RET)
(setq RET t)
RET
)
)
)
这个程序是作用是什么？给我们这些入门者指点指点. 没有看懂 构建windows下的快捷方式的的 班主真是高手啊。
页:
[1]