(defun menu-update (/ _kpblc-dir-create _kpblc-dir-path-and-splash _kpblc-get-file-date cur_user server loc_path loc_lst server_lst cui)
(defun _kpblc-get-file-date (file / lst res copy)
(if (findfile file)
(if (setq lst (vl-file-systime file))
(foreach item '((0 . 4) (1 . 2) (3 . 2) (4 . 2) (5 . 2) (6 . 2))
(setq res (append res
(list ((lambda (/ tmp)
(setq tmp (itoa (nth (car item) lst)))
(while (< (strlen tmp) (cdr item)) (setq tmp (strcat "0" tmp)))
tmp
) ;_ end of LAMBDA
)
) ;_ end of list
) ;_ end of append
) ;_ end of setq
) ;_ end of foreach
(progn (setq copy (strcat (_kpblc-get-path-temp) "\\" (vl-filename-base file) (vl-filename-extension file)))
(vl-file-copy file copy)
(setq res (_kpblc-get-file-date copy))
) ;_ end of progn
) ;_ end of if
) ;_ end of if
(cond ((and res (listp res)) (apply 'strcat res))
(res)
) ;_ end of cond
) ;_ end of defun
(defun _kpblc-dir-create (path / tmp)
(cond ((vl-file-directory-p path) path)
((setq tmp (_kpblc-dir-create (vl-filename-directory path)))
(vl-mkdir (strcat tmp
"\\"
(vl-filename-base path)
(cond ((vl-filename-extension path))
(t "")
) ;_ end of cond
) ;_ end of strcat
) ;_ end of vl-mkdir
(if (vl-file-directory-p path)
path
) ;_ end of if
)
) ;_ end of cond
) ;_ end of defun
(defun _kpblc-dir-path-and-splash (path) (strcat (vl-string-right-trim "\\" path) "\\"))
(setq server "\\\\server\\acad\\menus"
loc_path (strcat (_kpblc-dir-path-and-splash (getenv "appdata")) "kpblc\\adn-cis")
) ;_ end of setq
(if (setq cur_user (cdr
(assoc "menu"
(car
(vl-remove-if-not (function (lambda (x)
(and (wcmatch (strcase (getenv "username"))
(cond ((cdr (assoc "name" x)) (strcase (cdr (assoc "name" x))))
(t "*")
) ;_ end of cond
) ;_ end of wcmatch
(wcmatch (strcase (getenv "userdomain"))
(cond ((cdr (assoc "domain" x)) (strcase (cdr (assoc "domain" x))))
(t "*")
) ;_ end of cond
) ;_ end of wcmatch
) ;_ end of and
) ;_ end of lambda
) ;_ end of function
;; Список пользователей
'
((("name" . "kpblc") ("menu" "test1" "test2"))
(("name" . "oleg") ("domain" . "home") ("menu" "check1"))
)
) ;_ end of vl-remove-if-not
) ;_ end of car
) ;_ end of assoc
) ;_ end of cdr
) ;_ end of setq
(foreach file_menu (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash server) x)))
(vl-directory-files server "*.CUIX" 1)
) ;_ end of mapcar
;; Ищем локально файлы.
(cond ((and (findfile (strcat (_kpblc-dir-path-and-splash loc_path)
(vl-filename-base file_menu)
(vl-filename-extension file_menu)
) ;_ end of strcat
) ;_ end of findfile
(not (member (strcase (vl-filename-base file_menu)) (mapcar 'strcase cur_user)))
) ;_ end of and
;; Файл есть и он не среди cur_user, найти элемент меню, выгрузить и удалить файлы
(if (menugroup (vl-filename-base file_menu))
(vl-catch-all-apply
(function
(lambda ()
(vla-unload (vla-item (vla-get-menugroups (vlax-get-acad-object)) (vl-filename-base file_menu)))
) ;_ end of lambda
) ;_ end of function
) ;_ end of vl-catch-all-apply
) ;_ end of if
(foreach file (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash loc_path) x)))
(vl-directory-files loc_path (strcat (vl-filename-base file_menu) ".*"))
) ;_ end of mapcar
(vl-file-delete file)
) ;_ end of foreach
)
((and (not (findfile (strcat (_kpblc-dir-path-and-splash loc_path)
(vl-filename-base file_menu)
(vl-filename-extension file_menu)
) ;_ end of strcat
) ;_ end of findfile
) ;_ end of not
(member (strcase (vl-filename-base file_menu)) (mapcar 'strcase cur_user))
) ;_ end of and
;; Файла нет и он среди cur_user, скачать и загрузить
)
((and (findfile (strcat (_kpblc-dir-path-and-splash loc_path)
(vl-filename-base file_menu)
(vl-filename-extension file_menu)
) ;_ end of strcat
) ;_ end of findfile
(or ;; Сравниваем количество файлов указанного меню на сервере и локально. Если неодинакого - обновлять
(/= (length
(setq loc_lst (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash loc_path) x)))
(vl-remove-if (function (lambda (x) (member (strcase (vl-filename-extension x)) '(".MNR" ".MNC"))))
(vl-directory-files loc_path (strcat (vl-filename-base file_menu) ".*"))
) ;_ end of vl-remove-if
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of length
(length
(setq server_lst (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash server) x)))
(vl-remove-if (function (lambda (x) (member (strcase (vl-filename-extension x)) '(".MNR" ".MNC"))))
(vl-directory-files server (strcat (vl-filename-base file_menu) ".*"))
) ;_ end of vl-remove-if
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of length
) ;_ end of /=
;; Если одинакого и хотя бы один из файлов на сервере новее - обновлять
(apply (function or)
(mapcar (function (lambda (a b) (< (_kpblc-get-file-date a) (_kpblc-get-file-date b))))
loc_lst
server_lst
) ;_ end of mapcar
) ;_ end of apply
) ;_ end of or
) ;_ end of and
;; выгрузить меню, удалить файлы, скопировать локально и загрузить
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
(function
(lambda () (vla-unload (vla-get-menugroups (vlax-get-acad-object)) (vl-filename-base file_menu)))
) ;_ end of function
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
) ;_ end of not
(progn (foreach file (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash loc_path) x)))
(vl-directory-files loc_path (strcat (vl-filename-base file_menu) ".*"))
) ;_ end of mapcar
(vl-file-delete file)
) ;_ end of foreach
(foreach file server_lst
(vl-file-copy file
(strcat (_kpblc-dir-path-and-splash loc_path) (vl-filename-base file) (vl-filename-extension file))
) ;_ end of vl-file-copy
) ;_ end of foreach
(if (setq cui (cond ((findfile (strcat (_kpblc-dir-path-and-splash loc_path) (vl-filename-base file_menu) ".CUI")))
((findfile (strcat (_kpblc-dir-path-and-splash loc_path) (vl-filename-base file_menu) ".CUIX")))
) ;_ end of cond
) ;_ end of setq
;; Ну и собственно загрузка
(command-s "_.menuload" cui)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
)
) ;_ end of cond
) ;_ end of foreach
) ;_ end of if
) ;_ end of defun
