;;***************** SETUP1.LSP ********************
;;* Установка программ для Acad и других файлов, организация путей поиска Acad и загрузка меню.
;;* Общие примечания и настройки см. Acad.lsp, который запускается автоматически,
;;* если Acad запускается двойным щелчком по DWG файлу, располагаемого в этом же директории (дистрибутиве)
;;*
;;* Для Acad 15, 16
;;* (С) Косов А.И., (413-2) 65-05-10дом., г.Магадан, 2004 г.
;;* Site: http://geol-dh.narod.ru/
;;*
;;* Состав программы:
;;* acad.lsp - автоматически исполняемый файл (инициализация, загрузка программ, передача управления)
;;* setup1.lsp - основная программа установки
;;* setup1.dcl - описание диалоговых окон
;;* setup1_mes.lsp - файл сообщений программ (2 языка)
;;* doslib15.arx (или doslib16.arx) - библиотека для Acad 15 (или 16)
;;* *.dwg - любой файл
;;* и необязательные файлы:
;;* setup1.sld - рекламный слайд
;;* setup1_read_me.html - файл справки (рекомендации по установке)
;;* *.gif - картинки для файла справки
;;* *.css - стили текста для файла справки
;;*
;
; loglst$ - список строк для формирования файла-журнала с данными о процессе инсталляции
;
; Функция подсчета размера заданных по маске файлов в директории
;
(defun COUNT_SPACE (dir ext / size file_list file)
;dir= C:\\name1\\name2\\
;ext= "*.TXT" или "*.*" и пр.
(setq err$ "COUNT_SPACE")
(setq size 0)
(setq file_list (dos_filesize (strcat dir ext)))
; file_list = (("FailName.ext" . 28258.0) ("FailName.ext" . 28258.0)) в байтах
(if file_list
(foreach file file_list
(setq size (+ size (cdr file)))
);foreach
)
size ; В байтах
);end of **** COUNT_SPACE ****
;
; Функция вывода строки сообщения по его номеру в списке и
; принятого языка сообщений (mes_language-)
;
(defun MESS (num / mes2)
;num - номер сообщения
(if setup_meslist- ;имя списка сообщений (см. SETUP1_MES.LSP)
(if (setq mes2 (nth num setup_meslist-))
(setq mes2 (nth mes_language- mes2))
)
)
(if mes2
(setq mes2 mes2)
(progn
(alert (strcat (itoa num) "\nMessage not found.\nСообщение не найдено."))
(setq mes2 "_?_")
)
)
; возврат - строка сообщения
);end of **** MESS *****
;
; Функция формирования списка POP меню из файла меню
;
(defun GET_MENUPOP (file_menu / pop_lst menu_group str)
; file_menu - полное имя файла меню
(setq err$ "GET_MENUPOP")
(setq pop_lst '())
(setq df$ (open file_menu "r")) ; открываем файл для чтения
(if df$
(progn
(while (setq str (read-line df$)) ; читаем каждую строку (до конца файла)
(if (wcmatch str "*POP*")
(progn
(setq str (vl-string-trim " " str)) ; отбрасываем незначащие пробелы
(setq pop_lst (cons (substr str 4 9999) pop_lst)) ; включаем в список только имя
)
)
);while
)
(progn
(setq loglst$ (cons (strcat (MESS 5) ": " file_menu) loglst$)) ;5="Can not open file for reading"
(princ (strcat "\n" (MESS 5) ": " file_menu)) ;5="Can not open file for reading"
)
)
(if df$ (close df$)) ; закрываем файл
pop_lst
);end of ***** GET_MENUPOP *****
;
; Функция поиска в файле меню имени группового меню (первого из найденных)
;
(defun GET_MENUGROUP (file_menu / menu_group read_flag str)
; file_menu - полное имя файла меню
(setq err$ "GET_MENUGROUP")
(setq menu_group nil)
(setq df$ (open file_menu "r")) ; открываем файл для чтения
(if df$
(progn
(setq read_flag T)
(while (and read_flag (setq str (read-line df$))) ; читаем каждую строку (как только найдем искомое - чтение прекращаем)
(if (wcmatch str "*MENUGROUP*") ; если встречена подстрока
(progn
(setq str (vl-string-trim " " str)) ; отбрасываем незначащие пробелы
(setq menu_group (substr str 14 9999)) ; берем только имя группового меню
(setq read_flag nil)
)
)
);while
)
(progn
(setq loglst$ (cons (strcat (MESS 5) ": " file_menu) loglst$)) ;5="Can not open file for reading"
(princ (strcat "\n" (MESS 5) ": " file_menu)) ;5="Can not open file for reading"
)
)
(if df$ (close df$)) ; закрываем файл
menu_group
);end of ***** GET_MENUGROUP *****
;
; Функция выгрузки прежних и загрузки новых меню
;
(defun SET_MENU (setup_folder name_load_lst / flag pop_lst mname file_menu menu_group pop_lst)
; setup_folder - установочный директорий по типу "D:\\Program Files\\AutoCAD 2004\\FA programs\\"
; name_load_lst - список загружаемых меню по типу ("MENU_name1" "MENU_name2 ...)
(setq err$ "SET_MENU")
(setq flag T)
(setq alert_str "")
(if (and name_load_lst (> (length name_load_lst) 0))
(progn
(foreach mname name_load_lst
(progn
(setq file_menu (strcat setup_folder mname ".MNU")) ; полное имя файла меню
(if (dos_filep file_menu) ; найдено?
(progn
(setq menu_group (GET_MENUGROUP file_menu)) ; Извлекаем из файла наименование группы меню
(if (and menu_group (menugroup menu_group))
(progn
(setq loglst$ (cons (strcat (MESS 6) " " menu_group "...") loglst$)) ;6="Unloading menu group"
(command "._MENUUNLOAD" menu_group) ; Удаляем только выбранные меню, остальные остаются
)
)
(setq loglst$ (cons (strcat (MESS 7) " " mname "...") loglst$)) ;7="Loading menu"
(command "._MENULOAD" file_menu) ; Загружаем выбранные меню
(if (and menu_group (menugroup menu_group))
(progn
(princ (strcat "\n" (MESS 8) ": " menu_group)) ;8="Placing menugroup to main menu"
(setq loglst$ (cons (strcat (MESS 8) ": " menu_group) loglst$)) ;8="Placing menugroup to main menu"
(if (setq pop_lst (GET_MENUPOP file_menu)) ; Формируем список POP меню
(progn
(setq i 1) ; pop_number
(repeat (length pop_lst)
(progn
(PLACEMENU menu_group i) ; Вставляем POP меню на предпоследнее место в строке меню Acad
(setq i (1+ i))
)
);repeat
)
(princ (strcat "\n" (MESS 9) ": " mname)) ;9="Menu have no POPs"
)
)
)
)
(progn
(setq loglst$ (cons (strcat (MESS 10) ": " file_menu) loglst$)) ;10="Menu file not found"
(setq alert_str (strcat "\n" (MESS 10) ": " file_menu)) ;10="Menu file not found"
(setq flag nil)
)
)
)
);foreach
)
)
(if (/= alert_str "")
(alert alert_str) ; вывод предупреждения о не найденных файлов меню
)
flag
);end of **** SET_MENU ****
;
;;; ------------ PLACE THE EXPRESS PULL-DOWN FUNCTION -------------
;;; This function places the Express pull-down to the left of the
;;; second to last pull-down on the acad menu.
;;; ----------------------------------------------------------------
; Функция вставки выпадающих меню в главное меню Acad (на предпоследнее место)
;
(defun PLACEMENU (menuname pop_numb / cnt)
; menuname - имя pop меню
; pop_numb - номер
(setq err$ "PLACEMENU")
(setq cnt 1)
(while (< cnt 24)
(if (menucmd (strcat "P" (itoa cnt) ".1=?"))
(setq cnt (1+ cnt))
(progn
(if (> cnt 2)
(setq cnt (- cnt 1))
(setq cnt 2)
)
(menucmd (strcat "p" (itoa cnt) "=+" menuname ".pop" (itoa pop_numb)))
(setq cnt 25)
)
)
)
);end of *** PLACEMENU ***
;
; Функция копирования файлов
;
(defun COPY_FILES (source_dir dest_dir templ_dir / flag copystr )
; source_dir - полное имя директория дистрибутива
; dest_dir - инсталляционный директорий
; templ_dir - директорий с темплетами Acad
(setq err$ "COPY_FILES")
(setq flag T)
(setq copystr "") ; Формирование строки о том какие и сколько файлов скопировано
(setq copystr (strcat copystr "\n" (MESS 11) ":")) ;11="Copied files"
(setq copystr (strcat copystr "\n" "------------------"))
(setq loglst$ (cons (strcat (MESS 12) ": " dest_dir) loglst$)) ;12="Making folder"
(setq dest_dir (dos_mkdir dest_dir))
(if dest_dir
(progn
(dos_getprogress 2) ; Окно контроля процесса установки
(setq loglst$ (cons (strcat (MESS 13) " " dest_dir "*.*") loglst$)) ;13="Setting attributs 'read only' to zero..."
(dos_dirattrib dest_dir 0) ; Снимаем атрибуты READ-ONLY с директория и с файлов
(dos_attrib (strcat dest_dir "*.*") 0)
(dos_getprogress 5)
(setq loglst$ (cons (strcat (MESS 14) " " dest_dir) loglst$)) ;14="Copying application files to"
(if (dos_copy (strcat source_dir "\\*.*") dest_dir)
(progn
(setq loglst$ (cons (strcat (MESS 15) ": " ;15="Files are copied"
(itoa (setq len (length (dos_find (strcat dest_dir "\\*.*")))))) loglst$))
(setq copystr (strcat copystr "\n* [" (itoa len) "] " (MESS 16) ;16="Copied application files to"
": \t" dest_dir))
)
(progn
(setq loglst$ (cons (strcat "*!*" (MESS 17) ": " dest_dir) loglst$)) ;17="Copying failed!"
(setq copystr (strcat copystr "\n! " (MESS 18))) ;18="Application files copying failed!"
(setq flag nil)
)
)
(dos_getprogress 70)
(setq loglst$ (cons (strcat (MESS 13) " " dest_dir "*.*") loglst$)) ;13="Setting attributs 'read only' to zero..."
(dos_attrib (strcat dest_dir "*.*") 0)
)
(progn
(setq loglst$ (cons (strcat (MESS 19) ": " dest_dir) loglst$)) ;19="Can not make folder"
(setq copystr (strcat copystr "\n! " (MESS 19) ": " dest_dir)) ;19="Can not make folder"
(setq flag nil)
)
)
(dos_getprogress 72)
(if (= setup_copy_templ- 1) ; Нужно создать копии темплетов в папке поиска Acad (для темплетов)
(progn
(dos_dirattrib templ_dir 0) ; на всякий случай
(dos_attrib (strcat templ_dir "*.*") 0)
(setq copy_templ (dos_copy (strcat source_dir "\\*.dwt") templ_dir))
(if copy_templ
(progn
(setq loglst$ (cons (strcat (MESS 20) " " templ_dir) loglst$)) ;20="Copying templet(s) *.DWT to"
(setq copystr (strcat copystr "\n* " (MESS 20) ;20="Copying templet(s) *.DWT to"
": \t" templ_dir))
)
(progn
(setq loglst$ (cons (strcat "*!*" (MESS 21)) loglst$)) ;21="Templet(s) copying failed!"
(setq copystr (strcat copystr "\n! " (MESS 21))) ;21="Templet(s) copying failed!"
)
)
)
)
(dos_getprogress 74)
(if (/= copystr "")
(progn
(alert copystr) ; Выбод сообщения о скопированных файлах в окно предупреждений
(princ (strcat "\n\n" copystr)) ; и в текстовое окно Acad
(princ (strcat "\n" "-------------"))
)
)
flag ; T or nil - если копирование для файлов программ не состоялась
);end of *** COPY_FILES ****
;
; Функция создания и проверки путей поиска
;
(defun CHECK_PARAM ( / flag_OK flag_new path_repl_lst acadpaths_str)
(setq err$ "CHECK_PARAM")
(setq flag_OK T)
(setq flag_new nil)
(if (not (dos_dirp setup_folder-));setup_folder- на конце \\
(progn
(setq setup_folder- (dos_mkdir setup_folder-));создаем временно инсталляционный директорий типа "FA programs"
(setq flag_new T)
)
)
(setq path_del_lst$ '()) ; список путей, где встречены 'Имя_директория_программы' для удаления из списка
(setq path_repl_lst '()) ; список путей, где встречены 'Имя_директория_программы' для замены в списке
(setq pathacad_lst$ '()) ; список остальых путей
(if (dos_dirp setup_folder-)
(progn
; В old_support записываются существующие пути поддержки
(setq pref_obj$ (vla-get-Files (vla-get-Preferences (vlax-get-acad-object))))
(setq acadpaths_str (vla-get-SupportPath pref_obj$))
;;;(setq acadpaths_str (getenv "ACAD")); или так
(setq acadpaths_lst (DOVALUE_ALL_TRIM acadpaths_str ";"))
(setq loglst$ (cons (strcat (MESS 22) "..." ) loglst$)) ;22="Getting current acad search paths"
(setq loglst$ (cons (strcat "------------------------------------------") loglst$))
(foreach n acadpaths_lst
(cond ((and (wcmatch n (strcat "*" subdir_name$ "*"))) ; Ищем прежние пути с поддиректорием 'Имя_директория_программы'
(progn
(if (/= n (strcat setup_folder- subdir_name$))
(setq path_del_lst$ (cons n path_del_lst$)) ; Список удаляемых
(setq path_repl_lst (cons n path_repl_lst)) ; Список заменяемых
)
))
(T
(progn
(setq pathacad_lst$ (cons n pathacad_lst$)) ; Список остальных путей поиска
))
);cond
);foreach
(setq pathacad_lst$ (reverse pathacad_lst$))
)
(setq flag_OK nil)
)
(if (not (and pathacad_lst$ (> (length pathacad_lst$) 0))) ; Список путей Acad - пустой?
(setq flag_OK nil)
)
(if (and flag_new (not flag_OK))
(dos_rmdir setup_folder-) ; И удаляем временно созданный директорий
)
flag_OK
);end of *** CHECK_PARAM ****
;
; Функция возвращает порядковый номер в списке по значению элемента списка
;
(defun GETINDEX (item itemlist / m n)
(setq err$ "GETINDEX")
(setq n (length itemlist))
(if (> (setq m (length (member item itemlist))) 0)
(- n m)
nil
)
);end of ********** GETINDEX ************
;
; Функция формирования списка строк из строки с разделителями (здесь - обработка строки путей поиска)
;
(defun DOVALUE_ALL_TRIM (str delim / k sn lst1 c)
; str - строка
; delim - разделитель (здесь ";")
(setq err$ "DOVALUE_ALL_TRIM")
(setq k 1
sn ""
lst1 nil
);setq
(while (<= k (strlen str))
(setq c (substr str k 1))
(if (/= c delim)
(setq sn (strcat sn c))
(progn
; Предварительно отбрасываем незначащие нули и конечные "\\"
(setq lst1 (cons (vl-string-right-trim "\\" (vl-string-trim " " sn)) lst1))
(setq sn "")
)
)
(setq k (1+ k))
);while
(if (/= sn "")
(setq lst1 (cons (vl-string-right-trim "\\" (vl-string-trim " " sn)) lst1))
)
(reverse lst1)
);end of ******* DOVALUE_ALL_TRIM ********
;
; Функция вывода строки с перечнем загружаемых меню
;
(defun SET_MEST (setup_menu_str menu_name_lst / i menu_load_lst menu_load_str mestext menu_name mestext_all)
; setup_menu_str - список индексов меню
; menu_name_lst - и соответствующий ему список имен меню
(setq err$ "SET_MEST")
(setq menu_load_lst '())
(setq menu_load_str "")
(setq mestext (strcat (MESS 23) ": ")) ;23="Load menu(s)"
(if (or (wcmatch setup_menu_str "*0*") (= setup_menu_str "")) ; выбрано "Do not load menus at all."
(set_tile "-setup_inst_menu_txt" (setq mestext_all (strcat mestext "NO")))
(progn
(setq i 1)
(while (setq menu_name (nth i menu_name_lst))
(if (wcmatch setup_menu_str (strcat "*" (itoa i) "*"))
(progn
(setq menu_load_lst (append menu_load_lst (list menu_name)))
(setq menu_load_str (strcat menu_load_str "'" menu_name "' "))
)
)
(setq i (1+ i))
)
(set_tile "-setup_inst_menu_txt" (if (> (strlen (setq mestext_all (strcat mestext menu_load_str))) 55)
(strcat (substr mestext_all 1 50) "...") ; Обрезаем длинную строку
mestext_all
))
)
)
menu_load_lst ; по типу "Load menu(s): MENU-1 MENU-2 ..."
);end of **** SET_MEST ****
;
; Функция выбора пути инсталляции программ
;
(defun SET_DIR (setup_folder / flag_new path)
; setup_folder - директорий по умолчанию для инсталляции программ (или выбранный ранее пользователем)
(setq err$ "SET_DIR")
(setq flag_new nil)
(if (not (dos_dirp setup_folder))
(progn
(setq setup_folder (dos_mkdir setup_folder)) ; Создаем временно нужный директорий
(setq flag_new T)
)
)
; выводим диалоговое окно выбора директория
(setq path (dos_getdir (MESS 24) setup_folder ;24="Select a folder to install applications"
"" T))
(if (and path (> (strlen path) 3)) ; Не должно равняться С:\ (корневому директорию логического диска)
(progn
(setq setup_folder path)
(set_tile "-setup_folder" setup_folder) ; Обновляем поле ввода
(setq loglst$ (cons (strcat (MESS 25) ": " setup_folder) loglst$)) ;25="User is set installation folder"
)
)
(if flag_new
(dos_rmdir setup_folder) ; И удаляем временно созданный директорий (а вдруг пользователь прервет установку)
)
setup_folder
);end of *** SET_DIR ***
;
; Функция вывода диалогового окна, обработки параметров программы, проверок
; а также формирования путей поиска и сообщения о предстоящих действиях по инсталляции
;
(defun SHOW-DCL (dwg_dir menu_name_lst sld_name / flag i str strappl stracad)
; dwg_dir - каталог дистрибутива, где файлы SETUP и директорий с программными и другими файлами
; menu_name_lst - список файлов MNU в дистрибутиве
; sld_name - имя файла-слайда
(setq err$ "SHOW-DCL")
(setq flag T)
(if (= mes_language- 1) ; Какой диалого открываем (русский или английский)
(if (not (new_dialog "settings_SETUP1" dcl-id$)) (setq flag nil))
(if (not (new_dialog "settings_SETUP1_RUS" dcl-id$)) (setq flag nil))
)
(if flag
(progn
(MODE_SUP_WHATINST)
(set_tile "-setup_folder" setup_folder-) ; Инсталляционный директорий - редактирование вручную
(set_tile "-setup_copy_templ" (itoa setup_copy_templ-)) ; Флаг копирования темплетов
; Выводим усеченный путь к темплетам Acad для информации
(if setup_copy_templ_dir-
(set_tile "-setup_copy_templ_dir" (dos_compactpath setup_copy_templ_dir- 90))
(set_tile "-setup_copy_templ_dir" "")
)
; Куда добавлять путь поиска инсталлируемых программ (в начало или в конец списка путей)
(cond ((= setup_use_pgp- 1) (set_tile "-setup_use_pgp1" (itoa setup_use_pgp-))) ; в начале - инсталлированные программы
((= setup_use_pgp- 2) (set_tile "-setup_use_pgp2" (itoa setup_use_pgp-))) ; инсталлированные программы - в конце
);cond
(if (not (and menu_name_lst (> (length menu_name_lst) 0))) ; Список по типу ("MENU-1" "MENU-2" ...)
(progn
; Добавляем к списку строку, при выборе которой меню загружаться не будут
(setq menu_name_lst '((MESS 26))) ;26="Do not load menus at all."
(mode_tile "-setup_inst_menu" 1) ; выключаем, если файлы меню не найдены
)
(setq menu_name_lst (cons (MESS 26) menu_name_lst)) ;26="Do not load menus at all."
)
(start_list "-setup_inst_menu") ; формируем список для tile
(mapcar 'add_list menu_name_lst)
(end_list)
; Формируем строку с номерами меню, выбранными пользователем для загрузки
(if (not setup_menu_str-) ; это список типа ("0 3 4 7") или пустой
(if (and menu_name_lst (> (length menu_name_lst) 0))
(setq setup_menu_str- "1") ; первый по списку (0 = "Do not load menus at all.")
(setq setup_menu_str- "")
)
)
(set_tile "-setup_inst_menu" setup_menu_str-)
(setq menuload_lst$ (SET_MEST setup_menu_str- menu_name_lst))
(start_image "-setup_image")
(slide_image 0 0 (dimx_tile "-setup_image") (dimy_tile "-setup_image") sld_name) ; Выводим рекламный слайы
(end_image)
; Сообщение. При выборе Cancel - инсталляция будет прервана
(set_tile "error" (MESS 91)) ;91="[Cancel] - break installation."
(action_tile "-setup_folder" "(setq setup_folder- $value)")
(action_tile "-setup_folder_but" "(setq setup_folder- (SET_DIR setup_folder-))") ; Выбор инсталляционного директория по кнопке
(action_tile "-setup_copy_templ" "(setq setup_copy_templ- (atoi $value))(MODE_SUP_WHATINST)")
(action_tile "-setup_use_pgp1" "(setq setup_use_pgp- 1)")
(action_tile "-setup_use_pgp2" "(setq setup_use_pgp- 2)")
(action_tile "-setup_inst_menu" "(setq setup_menu_str- $value)(setq menuload_lst$ (SET_MEST setup_menu_str- menu_name_lst))")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "help" "(HELP_SETUP1 dwg_dir)") ; Вывод справки к программе (файл HTML)
(setq flag (start_dialog)) ; По какой кнопке выход из диалогового окна: 1 - OK, 0 - Cancel
(if (= flag 1)
(progn
(if (= (vl-string-trim " " setup_folder-) "") ; Если пустое поле с именем директория
(setq setup_folder- (strcat acad_loc_path$ "\\" appname_folder$ "\\")) ; Формирируем его со значением по умолчанию
)
(setq drive (car (dos_splitpath setup_folder-)))
(setq free_space (caddr (dos_chkdsk drive))) ; Проверяем наличие свобоного пространства на логическом диске
; Считаем размер инсталляционных файлов
(setq need_space- (* (COUNT_SPACE source_dir$ "*.*") 1.1)) ; Чуть увеличиваем, на всякий случай (создание MNC, и др.)
(if (and (< free_space need_space-) (/= (dos_drivetype drive) "FIXED")) ; Проверка достаточно ли места и винчестер ли
(progn
(setq flag 99) ; Флаг недостаточности места
(setq loglst$ (cons (strcat (MESS 27)) loglst$)) ;27="There is not enough disk space to install or not fixid disk."
; Информация о недостаточности места
(alert (strcat (MESS 27) ;27="There is not enough disk space to install or not fixid disk."
"\n" (MESS 28) ;28="Select another drive."
))
)
(progn
(setq flag (CHECK_PARAM)) ; Создание списка путей поиска Acad и списка существования в путях - имени дистрибутива
)
)
(if (and flag (/= flag 99))
(progn
(setq loglst$ (cons (strcat "") loglst$))
(setq loglst$ (cons (strcat (MESS 29)) loglst$)) ;29="SETUP INFORMATION"
(setq loglst$ (cons (strcat "------------------") loglst$))
(setq loglst$ (cons (strcat (MESS 30)) loglst$)) ;30="I read Licences Agreement and accept all the terms of the preceding L.A."
(setq loglst$ (cons (strcat "") loglst$))
(setq loglst$ (cons (strcat (MESS 31) ": " source_dir$) loglst$)) ;31="Istall applications from"
(setq loglst$ (cons (strcat (MESS 32) ": " setup_folder-) loglst$)) ;32="Path to install"
(setq str "") ; Формирование строки с данными о последующей процедуре инсталляции
(setq str (strcat str "\n" (MESS 30))) ;30="I read Licences Agreement and accept all the terms of the preceding L.A."
(setq str (strcat str "\n\n" (MESS 31) ": " source_dir$)) ;31="Istall applications from"
(setq str (strcat str "\n\n" (MESS 32) ": " setup_folder- subdir_name$ "\\")) ;32="Path to install"
(setq strmenu "")
(if menuload_lst$
(strcat strmenu (foreach n menuload_lst$ (setq strmenu (strcat strmenu "'" n "' "))))
(setq strmenu "")
)
(if (/= strmenu "")
(setq str (strcat str "\n\n" (MESS 33) ": " strmenu)) ;33="Loading menu(s)"
(setq str (strcat str "\n\n! " (MESS 34))) ;34="Menu(s) will NOT be loaded."
)
(setq str (strcat str "\n\n" (MESS 35) ": ")) ;35="New folder will be created (or substitute)"
(setq loglst$ (cons (strcat "" ) loglst$))
(setq loglst$ (cons (strcat (MESS 35) ":" ) loglst$)) ;35="New folder will be created (or substitute)"
(if (and (dos_dirp setup_folder- subdir_name$) (dos_find (strcat setup_folder- subdir_name$ "\\*.*")))
(progn
(setq str (strcat str "\n " "[" (MESS 36) "] " setup_folder- subdir_name$ "\\")) ;36="SUBST"
(setq loglst$ (cons (strcat "[" (MESS 36) "] " setup_folder- subdir_name$ "\\") loglst$)) ;36="SUBST"
)
(progn
(setq str (strcat str "\n " "[" (MESS 37) "] " setup_folder- subdir_name$ "\\")) ;37="NEW"
(setq loglst$ (cons (strcat "[" (MESS 37) "] " setup_folder- subdir_name$ "\\") loglst$)) ;37="NEW"
)
)
(setq str (strcat str "\n ** " (MESS 38) " " subdir_name$ ;38="Attention! All previous applications folders"
"\n " (MESS 39))) ;39="exclude foregoing folder may be deleted by hand after installation."
;
(setq str (strcat str "\n\n" (MESS 40) ":")) ;40="Acad search paths will be organize in following order now"
(setq loglst$ (cons (strcat "") loglst$))
(setq loglst$ (cons (strcat (MESS 40) ": ") loglst$)) ;40="Acad search paths will be organize in following order now"
(setq strappl (strcat "\n " setup_folder- subdir_name$)) ; Путь инсталляции программ
(setq stracad (strcat "\n " "** [ " (MESS 41) " ]")) ;41="Existing Acad search file paths (support, fonts, other programs etc.)"
(cond ((= setup_use_pgp- 1) ; Пути программ в начале
(progn
(setq str (strcat str strappl stracad))
(setq new_pathacad_lst$ (append (list (strcat setup_folder- subdir_name$)) pathacad_lst$))
))
(T ; Пути Acad в начале
(progn
(setq str (strcat str stracad strappl))
(setq new_pathacad_lst$ (append pathacad_lst$ (list (strcat setup_folder- subdir_name$))))
))
);cond
(foreach n new_pathacad_lst$
(setq loglst$ (cons n loglst$)) ; все пути (в том числе новый для программ)
);foreach
(setq loglst$ (cons (strcat "------------------------------------") loglst$))
(if path_del_lst$
(progn
(setq str (strcat str "\n" (MESS 42) ": " )) ;42="Old applications search path will be removed"
(setq loglst$ (cons (strcat (MESS 42) "") loglst$)) ;42="Old applications search path will be removed"
(foreach n path_del_lst$
(setq str (strcat str "\n " n)) ; Формирование строки с удаленными путями поиска
);foreach
(foreach n path_del_lst$
(setq loglst$ (cons n loglst$))
);foreach
(setq loglst$ (cons (strcat "= = = = " (MESS 43) " = = = =") loglst$)) ;43="end of setup information"
)
)
; Вывод окна сообщения для подтверждения правильности установочной процедуры
(setq choice (dos_msgbox str (MESS 44) 4 3 )) ;44="Is this correct?"
(if (= choice 6) ; Yes
(progn
(setq flag 1)
(setq loglst$ (cons (strcat (MESS 45) "\n") loglst$)) ;45="Installation information accepted by user."
)
(progn
(setq flag 10) ; повтор вывода окна диалогов, правка
(setq loglst$ (cons (strcat (MESS 46) "\n") loglst$)) ;46="Installation information declined by user."
)
)
(setq str_on_end$ str)
)
)
)
);flag=1
)
(progn
(setq loglst$ (cons (strcat (MESS 47)) loglst$)) ;47="Can not open dialog from 'SETUP1.DCL' file."
(alert (strcat (MESS 47) ;47="Can not open dialog from 'SETUP1.DCL' file."
"\n\n" (MESS 49) ;49="Cancel to install applications."
))
(setq flag nil)
)
)
flag
);end of ***** SHOW-DCL *****
;
; Функция проверки наличия файлов DWT и гашения атрибутов окна диалогов
;
(defun MODE_SUP_WHATINST ( / )
(setq err$ "MODE_SUP_WHATINST")
(if (not (dos_find (strcat source_dir$ "*.DWT"))) ; Поиск темплетов в дистрибутиве
(progn
(setq setup_copy_templ- 0 ) ; выключить флажок копирования файлов
(mode_tile "-setup_copy_templ" 1) ; выкл
)
)
(if (and (= setup_copy_templ- 1) (dos_dirp setup_copy_templ_dir-))
(mode_tile "-setup_copy_templ_dir" 0) ; вкл
(mode_tile "-setup_copy_templ_dir" 1) ; выкл
)
);end of *** MODE_SUP_WHATINST ***
;
; Функция записи в файл-журнал процесса инсталляции
;
(defun WRITE_LOG (loglst$ dwg_dir setup_folder ert / dir fn_log)
(setq err$ "WRITE_LOG")
(if (= (dos_drivetype (substr dwg_dir 1 2)) "CDROM")
(if setup_folder
(setq dir setup_folder) ; по месту установки
)
(setq dir dwg_dir) ; в дистрибутиве (если установка не с CD)
)
(if dir
(progn
(setq loglst$ (reverse loglst$))
(setq fn_log (strcat dir log_filename-))
(dos_dirattrib dir 0)
(dos_attrib (strcat dir "*.*") 0)
(setq df$ (open fn_log "w"))
(if df$
(progn
(foreach n loglst$
(write-line n df$)
);foreach
(princ (strcat "\n\n" (MESS 48) ": " ;48="All setup information wrote to log file"
"\n" dir log_filename-))
(if flag_close_dwg$ ; выход по Cancel (или Esc)
(progn
(alert (strcat "\n" (MESS 48) ": " ;48="All setup information wrote to log file"
"\n" dir log_filename-))
)
(if (not mes_end$) ; Не до конца
(progn
(if (and ert (/= ert ""))
(write-line (strcat "\n" "*Error* = " ert) df$)
)
(write-line (strcat "\n" (MESS 50)) df$) ;50="*ERROR* Setup is failed."
(alert (strcat "\n" (MESS 50) ;50="*ERROR* Setup is failed."
"\n\n" (MESS 48) ": " ;48="All setup information wrote to log file"
"\n" dir log_filename-))
)
)
)
)
(alert (strcat (MESS 51))) ;51="Can not open log file."
)
(if df$ (close df$))
)
(alert (strcat (MESS 52))) ;52="Can't set folder name to write log file."
)
);end of **** WRITE_LOG ****
;
; Функция вывода справки к программе (файла HTML)
;
(defun HELP_SETUP1 (dwg_dir / )
(setq err$ "HELP_SETUP1")
(if (dos_filep help_filename-)
(dos_htmlbox (MESS 53) (strcat dwg_dir help_filename-)) ;53="Setup ACAD applications"
(princ (strcat "\n" (MESS 54) " " help_filename-)) ;54="Help file not found."
)
);end *********** HELP_SETUP1 **************
;
; Функция обработки ошибок
;
(defun M_ERROR (ert)
; ert - строка ошибки
(if (not (member ert '("Function cancelled" "console break" "quit / exit abort")))
; какая ошибка произошла (кроме вышеперечисленных)
(princ (strcat "\n" (MESS 55) ": " ert)) ;55="ERROR in program SETUP1"
(setq err$ "")
)
(if (and err$ (/= err$ "")) (princ (strcat "\n" (MESS 56) ;56="Error in function name"
": " err$))) ; Какая функция (из файла SETUP1) вызывалась последней
(RESTORE_ON_EXIT ert) ; Возврат переменных, закрытие файлов и др.
(dos_getprogress T) ; убрать окно процесса установки
(prin1)
);end of ** M_ERROR **
;
; Функция возврата значения системных переменных, закрытия файлов, очистки памяти,
; формирования журнала процесса инсталляции и др.
;
(defun RESTORE_ON_EXIT (ert / )
; ert - строка ошибки
(setq err$ "RESTORE_ON_EXIT")
(if old-error (setq *error* old-error$)) ; Возврат к прежней функции обработки ошибок *error*
(if (not ert) (setq ert "")) ; нормальное завершение
(if dos_getprogress ; если окно процесса установки еще не закрыто
(dos_getprogress 95)
)
(if (and dwg_dir$ loglst$)
(WRITE_LOG loglst$ dwg_dir$ setup_folder- ert) ; сформировать LOG файл
(alert (strcat (MESS 57))) ;57="Can not form log file."
)
(dos_getprogress T) ; убрать окно процесса установки
(arxunload arxname$ nil) ; выгрузить функции DOSLib
(if dcl-id$ (unload_dialog dcl-id$)) ; выгрузить файл диалога
(if cmde$ (setvar "CMDECHO" cmde$)) ; возвратить значение cmdecho
(if fdia$ (setvar "FILEDIA" fdia$)) ; и filedia
(if df$ (close df$)) ; на всякий случай закрываем файл, вдруг выход по Esc или по ошибке
(setq MESS nil SET_MENU nil PLACEMENU nil COPY_FILES nil CHECK_PARAM nil
GETINDEX nil DOVALUE_ALL_TRIM nil SET_DIR nil SHOW-DCL nil MODE_SUP_WHATINST nil
HELP_SETUP1 nil M_ERROR nil RESTORE_ON_EXIT nil WRITE_LOG nil
$_SETUP1 nil
)
(prin1)
);end of ************** RESTORE_ON_EXIT **********
;
; Г Л А В Н А Я Ф У Н К Ц И Я
;
(defun $_SETUP1 (arxname$ ; имя DOSLib
appname_folder$ ; имя директория для установки (по умолчанию)
check_num_lst ; по типу (("*.*" 10) ("*.FAS" 5) ("*.LSP" 6))
check_name_lst ; по типу ("PER.BMP" "KAI-2001-FW.hlp" "SEEL.FAS")
loglst$ ; список для формирования LOG файла
sld_name ; имя слайда для диалогового окна (реклама)
/
flag maxmenu notfound_ext notfound_names subdir_lst lsti
ext numb len name str_name stralert menu_name_lst menu_lst
fname doit pr_key pr_key_locmach pr_key_curuser cur_prof str_getenv
; Глобальные переменные (в конце $ или -):
setup_use_pgp- setup_copy_templ- setup_folder-
setup_copy_templ_dir- setup_menu_str- err$ cmde$ fdia$ old-error$
df$ flag_close_dwg$ dwg_dir$
subdir_name$ source_dir$ acad_loc_path$
new_pathacad_lst$ pref_obj$ menuload_lst$
str_on_end$ mes_end$ )
(setq err$ "$_SETUP1")
; Здесь и далее - формирование списка сообщений в LOG файл (переменная loglst$)
(setq loglst$ (cons (strcat (MESS 58) "...") loglst$)) ;58="Initialization ot parameters"
(setq cmde$ (getvar "CMDECHO") ; Сохраняем текущие системные переменные
fdia$ (getvar "FILEDIA")
old-error$ *error* ; и функцю обработки ошибок
*error* M_ERROR ; Назначаем новую функцию обработки ошибок
)
(setvar "CMDECHO" 0) ; Устанавливаем нужное значение системных переменных
(setvar "FILEDIA" 0)
(vl-load-com) ; Загружаем библиотеку для VL* функций
(setq flag T) ; Контроль безошибочности процесса
(setq flag_close_dwg$ nil) ; Выход по Esc (Cancel)? Закрытие чертежа и вывод сообщение о LOG файле
(setq mes_end$ nil) ; Успешное завершение установки?
; Определяем текущий директорий (где был запущен чертеж, и где все установочные программы)
(setq dwg_dir$ (getvar "DWGPREFIX"))
(setq maxmenu 9) ; Максимально число файлов MNU для загрузки в поддиректории
(setq notfound_ext '()) ; Список расширений и количества не найденных файлов
(setq notfound_names '()) ; Список не найденных имен файлов
; Все файлы должны находиться в одном поддиректории! Число поддиректориев не более 1!
(setq loglst$ (cons (strcat (MESS 59) "...") loglst$)) ;59="Checking presence of supplied folder(s) and files in each folder"
(setq subdir_lst (dos_subdir dwg_dir$)) ; Список поддиректориев
(if (= (length subdir_lst) 1) ; Допускается только одни поддиректорий в дистрибутиве
; Полный путь к дистрибутиву и его имя
(setq source_dir$ (strcat dwg_dir$ (setq subdir_name$ (car subdir_lst)) "\\"))
(progn
(alert (strcat (MESS 60) ;60="There is no subfolder or more then one subfolders with source files to install."
"\n\n" (MESS 49) ;49="Cancel to install applications."
))
(setq flag nil) ; Дальнейшие действия бессмысленны
)
)
; Есть список с расширениями и количеством файлов для этих расширений (задается в Acad.lsp?)
(if (and flag check_num_lst (> (length check_num_lst) 0))
(progn
(setq loglst$ (cons (strcat (MESS 61) "...") loglst$)) ;61="Checking numbers of files"
(foreach lsti check_num_lst ; lsti=("*.FAS" 5)
(progn
(setq ext (car lsti))
(setq numb (cadr lsti))
(if (< (setq len (length (dos_find (strcat source_dir$ ext)))) numb) ; по данному расширению все файлы?
(setq notfound_ext (cons (list ext (- numb len)) notfound_ext)) ; по типу ((ext1 numbers1) ...)
)
)
);foreach
)
)
; Еесть список с именами файлов для проверки (задается в Acad.lsp?)
(if (and flag check_name_lst (> (length check_name_lst) 0))
(progn
(setq loglst$ (cons (strcat (MESS 62) "...") loglst$)) ;62="Checking names of files"
(foreach name check_name_lst ; name="SEEL.FAS"
(progn
(if (not (dos_find (strcat source_dir$ name))) ; по данному имени есть файл?
(setq notfound_names (cons name notfound_names)) ; по типу (file1.ext file2.ext ...)
)
)
);foreach
)
)
; Если были заданы списки для проверки количества файлов и/или имен
; и если проверка выявила недостачу - информируем пользователя
(if (and flag (or notfound_ext notfound_names))
(progn
(setq str_ext "") ; Далее формируем строку по данным списка ненайденных файлов (количество)
(if notfound_ext ; Список с расширениями и количеством файлов
(progn
(setq notfound_ext (reverse notfound_ext))
(setq loglst$ (cons (strcat (MESS 63) " \\" subdir_name$ ":") loglst$)) ;63="Some files not found in subfolder"
(foreach lsti notfound_ext
(progn
(setq str_ext (strcat str_ext "\n " (itoa (cadr lsti)) " " (MESS 64) " " (car lsti))) ;64="for"
(setq loglst$ (cons (strcat " " (itoa (cadr lsti)) " " (MESS 64) " " (car lsti)) loglst$)) ;64="for"
)
);foreach
; В итоге str_ext = "NNN для EXT"
)
)
(setq str_name "") ; Далее формируем строку по данным списка ненайденных файлов (имена)
(if notfound_names ; Список имена файлов
(progn
; Сортировка списка имен файлов в алфавитном порядке
(setq notfound_names (vl-sort notfound_names (function (lambda (e1 e2) (< e1 e2)))))
(setq loglst$ (cons (strcat (MESS 65) " \\" subdir_name$ ":") loglst$)) ;65="Not found files in subfolder"
(foreach name notfound_names
(progn
(setq str_name (strcat str_name "\n " name))
(setq loglst$ (cons (strcat " " name) loglst$))
)
);foreach
)
)
; Общая строка с полной информацией о результатах проверки
(setq stralert (strcat
(if (/= str_name "")
(strcat "\n\n" (MESS 63) " \\" subdir_name$ ":" ;63="Some files not found in subfolder"
"\n" str_name
)
""
)
(if (/= str_ext "")
(strcat "\n\n" (MESS 67) " \\" subdir_name$ ":" ;67="Number of not found files with extentions in subfolder"
"\n" str_ext
)
""
)
"\n\n" (MESS 49) ;49="Cancel to install applications."
))
; Вывод окна сообщения (одна кнопку OK и картинка восклицательного знака
(dos_msgbox stralert (MESS 68) 1 1 ) ;68="Attention!"
(setq flag nil) ; Дальнейшие действия бессмысленны
(setq loglst$ (cons (MESS 69) loglst$)) ;69="Cancelling installation."
)
)
; Формирование списка меню (файлов) и проверка их количества (не более 9)
(if flag
(progn
(setq menu_name_lst '()) ; Список меню файлов (без расширения)
(setq loglst$ (cons (strcat (MESS 70) "...") loglst$)) ;70="Forming menu list"
(setq menu_lst (dos_find (strcat source_dir$ "*.MNU"))) ; Список всех файлов MNU
(if (and menu_lst (> (length menu_lst) 0) (<= (length menu_lst) maxmenu)) ; Ограничение до 9
(progn
(foreach fname menu_lst
(progn
(setq menu_name (caddr (dos_splitpath fname))) ; Имя файла без расширения
(setq menu_name_lst (cons menu_name menu_name_lst))
)
);foreach
; Сортировка по возрастанию имен меню
(setq menu_name_lst (vl-sort menu_name_lst (function (lambda (e1 e2) (< e1 e2)))))
)
(progn
(if (and menu_lst (> (length menu_lst) maxmenu))
(progn
; Сообщение об ошибке
(alert (strcat (MESS 71) ": [" (itoa (length menu_lst)) "]" ;71="Too many menu files"
"\n\n" (MESS 72) ;72="Allowed only 9."
))
(setq loglst$ (cons (strcat (MESS 71) ": [" (itoa (length menu_lst)) "]. " ;71="Too many menu files"
(MESS 72)) loglst$)) ;72="Allowed only 9."
)
)
; Меню для загрузки нет
)
)
)
)
; Загрузка диалогового окна (задание параметров загрузки)
(if flag
(progn
(setq loglst$ (cons (strcat (MESS 73) "...") loglst$)) ;73="Loading DCL"
(setq dcl-id$ (load_dialog "SETUP1")) ; Загрузка DCL
(if (minusp dcl-id$)
(progn
(setq loglst$ (cons (MESS 74) loglst$)) ;74="Can not load 'SETUP1.DCL' dialog file."
(setq loglst$ (cons (MESS 49) loglst$)) ;49="Cancel to install applications."
(alert (strcat (MESS 74) ;74="Can not load 'SETUP1.DCL' dialog file."
"\n\n" (MESS 49) ;49="Cancel to install applications."
))
(setq flag nil) ; Дальнейшие действия бессмысленны
)
(setq loglst$ (cons (strcat (MESS 75)) loglst$)) ;75="DCL loaded."
)
)
)
(if flag
(progn
; Инициализация ключей для диалогового окна по умолчанию
(setq setup_use_pgp- 2) ; [1 или 2] 1 - путь к устанавливаемым программам выше всех путей Acad;
; 2 - ниже всех путей
(setq setup_copy_templ- 1) ; [0 или 1] 1 - дополнительно копировать темплеты (если есть), 0 - нет
(setq doit T) ; Продолжать показывать диалоговое окно в цикле
; Инициализация директориев
(setq setup_folder- "") ; Установочный директорий (куда будет копироваться папка дистрибутива
; Задавать по тому директорию, где acad.exe
(setq setup_copy_templ_dir- nil) ; Путь для дополнительного копирования темплетов *.DWT
(setq pr_key (vlax-product-key)) ; Путь к ключу регистра Windows, с данными о текущем Acad
(if pr_key
(progn
; Добавляем суффикс типа данных реестра
(setq pr_key_locmach (strcat "HKEY_LOCAL_MACHINE\\" pr_key))
(setq pr_key_curuser (strcat "HKEY_CURRENT_USER\\" pr_key))
)
(setq pr_key_locmach nil pr_key_curuser nil)
)
(setq loglst$ (cons (strcat (MESS 76) "...") loglst$)) ;76="Seeking paths in Windows registry"
(if (and pr_key_locmach pr_key_curuser)
(progn
; appname_folder$ задается в файле Acad.lsp
(if (setq acad_loc_path$ (vl-registry-read pr_key_locmach "AcadLocation"))
; Если найден путь к Acad.exe определяем путь к устанавливаемым программам в папку с Acad.exe
(setq setup_folder- (strcat acad_loc_path$ "\\" appname_folder$ "\\"))
; Если нет то в (system) Program files folder
(setq setup_folder- (strcat (dos_specialdir 38) appname_folder$ "\\"))
)
; По имени профиля Acad ищем путь к папке с темплетами
(if (setq cur_prof (vl-registry-read (strcat pr_key_curuser "\\" "Profiles")))
(setq setup_copy_templ_dir- (vl-registry-read (strcat pr_key_curuser "\\" "Profiles" "\\" cur_prof "\\" "General") "TemplatePath"))
)
)
(progn
(setq loglst$ (cons (strcat (MESS 66)) loglst$)) ;66="Can't found paths to Acad.exe and/or Acad templets."
(setq flag nil) ; Дальнейшие действия бессмысленны
)
)
(while doit
(setq loglst$ (cons (strcat (MESS 77) "...") loglst$)) ;77="Opening dialog window"
(if (setq flag (SHOW-DCL dwg_dir$ menu_name_lst sld_name)) ; Передаем в функцию текущий директорий и список меню
(progn
(cond ((= flag 0) ; Выход по кнопку Cancel или клавише Esc
(progn
(setq loglst$ (cons (strcat "\n" (MESS 78)) loglst$)) ;78="Installation is canceled by user."
(alert (strcat "\n" (MESS 78))) ;78="Installation is canceled by user."
(setq flag_close_dwg$ T)
(setq flag nil doit nil) ; выход по Ecs
)
)
((= flag 1)
(progn ; все в норме!!
(setq loglst$ (cons (strcat (MESS 79) "...") loglst$)) ;79="Copying files to installation folder"
(setq loglst$ (cons (strcat "--------------------------------------------------") loglst$))
; Инициализируем окно процесса установки
(dos_getprogress (MESS 80) ;80="Copying files..."
(MESS 81) 100) ;81="Wait! Do not press Esc key!"
(setq flag (COPY_FILES source_dir$ ; Исходный директорий
(strcat setup_folder- subdir_name$ "\\") ; Инсталляционный директорий
setup_copy_templ_dir-)) ; Директорий для темплетов
(setq loglst$ (cons (strcat "-----------------") loglst$))
(setq loglst$ (cons (strcat (MESS 82)) loglst$)) ;82="End copying."
(if flag ; Копирование успешно
; Список путей поиска new_pathacad_lst$ формируется после SHOW-DCL
(if (and new_pathacad_lst$ (> (length new_pathacad_lst$) 0))
(progn
(setq str_getenv "")
(princ (strcat "\n\n" (MESS 83) ":")) ;83="Current acad search paths now"
(princ (strcat "\n" "--------------------------------"));
(foreach n new_pathacad_lst$
(progn
(princ (strcat "\n " n))
(if (/= n "")
(setq str_getenv (strcat str_getenv n ";")) ; Формируем строку в формате PATH
)
)
);foreach
(princ "\n")
(setq loglst$ (cons (strcat (MESS 84) "...") loglst$)) ;84="Setting new acad search paths"
; Изменяем (дополняем) пути поддержки
(vla-put-SupportPath pref_obj$ str_getenv)
;;;(setenv "ACAD" str_getenv); можно и так
(dos_getprogress 85)
)
(progn
; Маловероятная ошибка
(setq loglst$ (cons (strcat (MESS 85)) loglst$)) ;85="*Error* No list of search paths."
(alert (strcat (MESS 85))) ;85="*Error* No list of search paths."
(setq flag nil)
)
)
(progn
; Возникли ошибки при копировании
(setq loglst$ (cons (strcat (MESS 86)) loglst$)) ;86="Fatal error while copying main program files!"
(alert (strcat (MESS 86))) ;86="Fatal error while copying main program files!"
)
)
(if flag
(progn
; Загрузка меню
(setq loglst$ (cons (strcat (MESS 87) "...") loglst$)) ;87="Setting menus"
(setq flag (SET_MENU (strcat setup_folder- subdir_name$ "\\") ; Инсталляционный директорий
menuload_lst$)) ; Список загружаемых меню (см. SHOW-DCL)
(setq loglst$ (cons (strcat (MESS 88) "...") loglst$)) ;88="End of setting menus"
(dos_getprogress 90)
)
)
(if flag
(progn
(setq loglst$ (cons (strcat "\n" (MESS 89) " " ;89="Congratulation!"
(MESS 90)) loglst$)) ;90="Programs install successfully!"
(princ (strcat "\n\n" (MESS 29) ":")) ;29="SETUP INFORMATION"
(princ (strcat "\n" "-------------------"))
(princ (strcat "\n" str_on_end$)) ; что делаем (см. SHOW-DCL)
(princ (strcat "\n" "-------------------"))
(setq mes_end$ (strcat (MESS 90) ;90="Programs install successfully!"
"\n\n" (MESS 48) ": " ;48="All setup information wrote to log file"
"\n" log_filename-))
; Вывод окна сообщений
(dos_msgbox (strcat mes_end$ " ") (MESS 89) 1 1 ) ;89="Congratulation!"
)
)
(setq flag T doit nil) ; выход из цикла
)
)
(T (setq doit T)) ; еще раз выводим окно, какие-то ошибки
);cond
)
(progn
(setq loglst$ (cons (strcat "\n" (MESS 69)) loglst$)) ;69="Cancelling installation."
(alert (strcat "\n" (MESS 69))) ;69="Cancelling installation."
(setq flag_close_dwg$ T)
(setq flag nil doit nil) ; выход по Ecs
)
)
);while
)
(progn
(setq loglst$ (cons (strcat "\n" (MESS 69)) loglst$)) ;69="Cancelling installation."
(alert (strcat "\n" (MESS 69))) ;69="Cancelling installation."
(setq flag_close_dwg$ T)
(setq flag nil doit nil) ; выход по Ecs
)
)
; Возврат переменных, закрытие файлов и др.
(RESTORE_ON_EXIT nil) ; Нормальное завершение (без ошибок и без нажатия на Esc)
(if flag_close_dwg$
(command "._QUIT" "_Y") ; Закрытие чертежа
)
(prin1)
);end of **** $_SETUP1 ****
 |
|
СПДС. Установка программ. Файл SETUP1.LSP (основной). 
