Главная СПДС СПДС. Установка программ. Файл SETUP1.LSP (основной).
;;***************** 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 ****
	

  при полном или частичном использовании материалов сайта ссылка на источник обязательна ©2002-2012