[Red Nova]

Есть ли возможность простым методом сделать из совокупности лисп кодов и меню программу хоть по минимуму защищенную от взлома? Так чтобы поставил программу на конкретный компьютер вписал активационный ключ, который неким образом связан скажем с mac адресом конкретного компьютера. Затем программа устанавливается на компьютер, но так чтобы нельзя было просто скопировать ее на другой компьютер и прописать в автозагрузку Автокада.

[Alaspher]

Была очень похожая тема.

[Red Nova]

Дима_,
Я в итоге получу то что ты и говоришь. Часть кода будет в реестре. Просто я хочу иметь возможность на растоянии проводить активацию. А для этого я хочу сделать активационный код.

Я тут копался с кодом от VVA, хочу на команды все поставить. Подскажите в чем код ошибочен.

Код:

[Выделить все]

(defun C:dserial  (/kod, ret)
(setq kod (getstring "Введите серийный номер")
(setq ret (apply 'strcat
                 (mapcar 'chr
                         (mapcar '(lambda (x) (boole 6 x 12))
                                 (vl-string->list kod)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
) ;_ end of defun

[Alaspher]

Видимо так задумывалось:

Код:

[Выделить все]

(defun C:dserial (/ kod ret)
 (setq kod (getstring "Введите серийный номер"))
 (setq ret (apply 'strcat
                  (mapcar 'chr (mapcar '(lambda (x) (boole 6 x 12)) (vl-string->list kod)))
           )
 )
)

[VVA]

Как вариант, можно первые 4 (например) символа получать случайным образом и не обрабатывать. Или комбинировать: нечетный - случайный, четный - твой.

Код:

[Выделить все]

;;; Maxnum - максимальное число
;;; Minnum - минимальное число
(defun randomgen (Minnum Maxnum / Diff vk_RandNum)
;;Random
;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=32692Wn
(defun vk_RandNum (/ modulus multiplier increment random)
  (if (not *seed*)
    (setq *seed* (getvar "DATE"))
  )
  (setq  modulus     65536
  multiplier 25173
  increment  13849
  *seed*     (rem (+ (* multiplier *seed*) increment) modulus)
  random     (/ *seed* modulus)
  )
)
(setq Diff (- Maxnum Minnum))
(- Maxnum (atoi (rtos (* Diff (vk_RandNum)) 2 0)))
)


(defun C:dserial (/ kod ret buf)
 (setq kod (getstring "Введите серийный номер"))
 (setq ret (apply 'strcat
                  (mapcar 'chr (mapcar '(lambda (x) (boole 6 x 12)) (vl-string->list kod)))
           )
 )
  (setq buf "")
  (repeat 4 (setq buf (strcat buf (chr(randomgen 32 128)))))
  (setq ret (strcat  buf ret))
 )

Твои символы - (substr ret 5)

[Red Nova]

У меня пока получился такой код.
Язер запускает на компьютере такой код

Код:

[Выделить все]

(defun C:serial (/)
(setq usr (apply 'strcat  (list (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER"))))  
(setq kod (apply 'strcat
                 (mapcar 'chr
                         (mapcar '(lambda (x) (boole 6 x 12))
                                 (vl-string->list usr)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
) ;_ end of defun

Полученный результат отсылается мне.
Я вычисляю реальные данные компьютера таким кодом.

Код:

[Выделить все]

(defun C:dserial (/)
 (setq kod (getstring "Введите серийный номер "))
 (setq ret (apply 'strcat
                  (mapcar 'chr (mapcar '(lambda (x) (boole 6 x 12)) (vl-string->list kod)))
           )
 )
)

Потом я компилирую активационный код

Код:

[Выделить все]

(defun C:getactivatecode (/)
(setq usr2 (getstring "Введите данные пользователя "))  
(setq kod2 (apply 'strcat
                 (mapcar 'chr
                         (mapcar '(lambda (x) (boole 6 x 10))
                                 (vl-string->list usr2)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
) ;_ end of defun

Отправляю скомпилированный лисп юзеру, который должен на своем компьютере должен загрузить такой лисп, и вставить на запрос активационный код.

Код:

[Выделить все]

(defun C:activate (/)
(setq usr (apply 'strcat  (list (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER"))))  
(setq kod2 (apply 'strcat
                 (mapcar 'chr
                         (mapcar '(lambda (x) (boole 6 x 10))
                                 (vl-string->list usr)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
(setq ret2 (getstring "Введите активационный номер "))
(if (= kod2 ret2) 
(vl-registry-write "HKEY_CURRENT_USER\\SECRET\\NUMCOD" "" "часть защищаемого кода, который записываем")
);_end of if
(princ)
);_ end of defun

Вот только не знаю на сколько корректен последний код. При его испытании всегда возвращает nil, может я опять напортачил?

[Red Nova]

VVA,
Возникла проблема. Тестировал код с предыдущего поста, и вот что обнаружил.
Пытаюсь командой getactivatecode получить активационный код, ввожу к примеру такие данные
ArmenakDESIGNARMENAK\\\\LION
а программа почему-то запоминает
ArmenakDESIGNARMENAK\\\\\\\\LION
ролик пробы в vlide прилагаю

[Кулик Алексей aka kpblc]

Каждый "одинарный" слеш при работе в лиспе меняется на двойной.

[Red Nova]

Хм. Ну в принципе это можно учесть заранее и ввести в ком строку на половину слешов меньше. Тестирую дальше.

Код:

[Выделить все]

Command:
Command: serial
"M~aibmgHI_EKBM^AIBMGPP@ECB"

Command:
Command: dserial
Введите серийный номер M~aibmgHI_EKBM^AIBMGPP@ECB
"ArmenakDESIGNARMENAK\\\\LION"

Command:
Command: getactivatecode
Введите данные пользователя ArmenakDESIGNARMENAK\\LION
"KxgodkaNOYCMDKXGODKAVVFCED"

Command:
Command: activate
Введите активационный номер KxgodkaNOYCMDKXGODKAVVFCED
nil

Command:

после этого я проверил реестр. Нужная строка не вписалась, а значит код activate ошибочен, помогите найти ошибку пожалуйста.

[VVA]

Red Nova, Ничего учитывать не нужно. Пиши как вернуло с 8 слэшами. Затем смотри реестр. Сравни строчку из твоего кода #45

Код:

[Выделить все]

(vl-registry-write "HKEY_CURRENT_USER\\SECRET\\NUMCOD" "" "часть защищаемого кода, который записываем в реестр")

Фрагмент справки по AutoLISP

Within quoted strings, the backslash (\) character allows control characters (or escape codes) to be included. The following table shows the currently recognized control characters: AutoLISP control characters Code-Description \\ -\ character \" -" character \e -Escape character \n -Newline character \r -Return character \t -Tab character \nnn -Character whose octal code is nnn The prompt and princ functions expand the control characters in a string and display the expanded string in the AutoCAD Command window. If you need to use the backslash character (\) or quotation mark (") within a quoted string, it must be preceded by the backslash character (\). For example, if you enter _$ (princ "The \"filename\" is: D:\\ACAD\\TEST.TXT. ") the following text is displayed in the AutoCAD Command window: The "filename" is: D:\ACAD\TEST.TXT You will also see this output in the VLISP Console window, along with the return value from the princ function (which is your original input, with the unexpanded control characters).

[Red Nova]

VVA,
Спасибо, но ты не совсем верно меня понял.
Проблема с двойным слешом у меня была на другой стадии, когда я пытаюсь сгенерировать активационный код, а вот главная проблема не в этом, а в том, что в итоге в реестр ничего не записывается, то есть мой последний код ошибочен.
Юзер выполняет

Код:

[Выделить все]

Command: serial
"M~aibmgHI_EKBM^AIBMGPP@ECB"

Отправляет этот код мне
Я выполняю

Код:

[Выделить все]

Command:
Command: dserial
Введите серийный номер M~aibmgHI_EKBM^AIBMGPP@ECB
"ArmenakDESIGNARMENAK\\\\LION"

Command:
Command: getactivatecode
Введите данные пользователя ArmenakDESIGNARMENAK\\LION
"KxgodkaNOYCMDKXGODKAVVFCED"

Отправняю активационный код юзеру, и он выполняет

Код:

[Выделить все]

Command: activate
Введите активационный номер KxgodkaNOYCMDKXGODKAVVFCED
nil

При проверке оказалось, что команда activate не записывает в реестр ничего. Проверь пожалуйста этот код.

Код:

[Выделить все]

(defun C:activate (/)
(setq usr (apply 'strcat  (list (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER"))))  
(setq kod2 (apply 'strcat
                 (mapcar 'chr
                         (mapcar '(lambda (x) (boole 6 x 10))
                                 (vl-string->list usr)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
(setq ret2 (getstring "Введите активационный номер "))
(if (= kod2 ret2) 
(vl-registry-write "HKEY_CURRENT_USER\\SECRET\\NUMCOD" "" "часть защищаемого кода, который записываем")
);_end of if
(princ)
);_ end of defun

Добавлено
Нашел таки в чем была ошибка. Теперь все заработало. Код исправил

[Sleekka]

Через пару месяцев придет на dwg пользователь и спросит, тут нам один нехороший человек защиту поставил а я хочу работать дома, помогите сломать - придется его отправить в поиск...

[Дима_]

Вариант защиты программы из поста #4 шифрованием куска кода

Сама программа:

Код:

[Выделить все]

(defun C:NUM ( / ss start i lst ed str )
  (vl-load-com)
  (and (setq start (getint "\nНачальный номер <выход>: "))
       (setq ss (ssget "_:L" '((0 . "*TEXT"))))
       (setq lst nil i '-1)
       (repeat (sslength ss)
	 (setq lst (cons (ssname ss (setq i (1+ i))) lst))
	 )

(cryptrun "HKEY_CURRENT_USER\\SECRET\\NUMCOD" (strcat (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER")))

       (foreach e1 lst
	 (setq ed (entget e1))
	 (setq str (cdr(assoc 1 ed)))
	 (setq ed (subst (cons 1 (itoa start))
			 (assoc 1 ed)
			 ed)
	       )
	 (entmod ed)
	 (setq start (1+ start))
	 )
       )
  (princ)
  )

Лисп обеспечивающий выполнение работы:

Код:

[Выделить все]

(vl-load-com)
(defun cryptinfo (inf key / i); зашифровывает/расшифровывает значение inf ключом key
(setq i -1 key (vl-string->list key))
(vl-list->string
(mapcar '(lambda (x)
(if (not (nth (1+ i) key)) (setq i -1))
(setq i (1+ i))
(boole 6 x (nth i key))
);end of lambda 
(vl-string->list inf)
);end of mapcar
);end of vl-list->string
);end of cryptinfo

(vl-load-com)
(defun checksum (str len / tmp) ; возращает контрольную сумму строки str длинной len символов
(setq tmp (itoa (apply '+ (vl-string->list str))))
(if (/= len (strlen tmp))
(if (> len (strlen tmp))
(repeat (- len (strlen tmp)) (setq tmp (strcat "0" tmp)))
(setq tmp (substr tmp len)) 
));end of if*2
tmp
);end of checksum

(vl-load-com)
(defun getinfo ( / File); сохраняет данные о пользователе
(setq File (getfiled "Куда сохранить информационный файл" "user" "dat" 1))
(if File
(progn
(setq File (open File "W"))
(princ (cryptinfo (strcat (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER")) "ключевое слово") File)
(close File)
);end of progn
(alert "Файл не создан")
);end of if
);end of getinfo

;пример (makeserial "(setq lst (mapcar '(lambda (x) (cdr x)) lst))")
;Обратить внимание на возможное наличие кавычек внутри кавычек.
(vl-load-com)
(defun makeserial ( cod / File str); создает ключевой файл для кода cod - для использования программистом.
(setq File (getfiled "Укажите файл данных" "user" "dat" 2))
(if file
(progn
(setq 	File (open File "R")
	str (cryptinfo "здесь идет код программы" (cryptinfo (read-line File) "ключевое слово"))
);end of setq
(close File)
(setq File (getfiled "Куда сохранять ключ активации" "Regkey" "dat" 1))
(if File
(progn
(setq File (open File "W"))
(princ (strcat str (checksum str 7)) file)
(close File)
);end of progn
(alert "Файл не сохранен")
);end of if 
);end of progn
(alert "Файл не выбран")
);end of if
);end of makeserial

; пример (activate "HKEY_CURRENT_USER\\SECRET\\NUMCOD")
(vl-load-com)
(defun activate ( regpath / File str); производит активацию программы в указанном пути реестра
(setq File (getfiled "Укажите файл с ключом активации" "Regkey" "dat" 2))
(if File
(progn
(setq 	File (open file "R")
	str (read-line File)	
);end of setq
(close File)
(if (= (checksum (substr str 1 (- (strlen str) 7)) 7) (substr str (- (strlen str) 6)))
(progn
(vl-registry-write regpath "" str)
(alert "Программа успешно зарегистрированна")
);end of progn
(alert "Неверный ключ активации")
);end of if
);end of progn
(alert "Файл не найден")
);end of if
);end of activate

; пример (cryptrun "HKEY_CURRENT_USER\\SECRET\\NUMCOD" (strcat (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER")))
(vl-load-com)
(defun cryptrun (regpath key / cod temp File); запускает код инициированный в реестре regpath, зашифрованный ключом key
(setq cod (vl-registry-read regpath))
(if cod
(if (= (checksum (substr cod 1 (- (strlen cod) 7)) 7) (substr cod (- (strlen cod) 6)))
(progn
(setq temp (vl-filename-mktemp "secret.lsp") File (open temp "w"))
(princ (cryptinfo (substr cod 1 (- (strlen cod) 7)) key)  File)
(close File)
(load temp)
(vl-file-delete temp)
);end of progn
(alert "Неверный ключ активации")
);end of if
(alert "Программа не зарегистрированна")
);end of if
);end of cryptrun

Обращаю внимание внимание процедура "makeserial" не нужна, и не желательна в пользовательской программе.

Порядок выполнения регистрации (процедуры включить в оформленные по своему усмотрению программы):
На машине пользователя
(getinfo) - полученный файл "user.dat" отослать программисту

На машине программиста:
(makeserial "(setq lst (vl-sort lst '(lambda (e1 e2) (> (caddr(assoc 10 (entget e1)))(caddr(assoc 10 (entget e2)))))))")
полученный файл "regkey.dat" - отослать пользователю

На машине пользователя:
(activate "HKEY_CURRENT_USER\\SECRET\\NUMCOD")
После этого программа должна работать.

P.S. Аналогично с любой другой программой - выдераем кусок кода - вставяем его как параметр при выполнении makeserial - не забыть учесть возможные кавычки внутри кода - " заменить на /"

P.P.S. исправленна небольшая ошибка в cryptinfo.

[Red Nova]

Так, как защитить один код я понял. Теперь хочу защитить несколько кодов. Для этого команда activate с #50 должна записать в реестр сразу несколько строк.
Я позабыл какую функцию нужно добавить в if чтобы можно было при T провести сразу несколько операций. Напомните пожалуйста.
Имею

Код:

[Выделить все]

(if (= kod2 ret2) 
(vl-registry-write "HKEY_CURRENT_USER\\SECRET\\NUMCOD" "" "часть защищаемого кода, который записываем")
);_end of if

Вместо

Код:

[Выделить все]

(vl-registry-write "HKEY_CURRENT_USER\\SECRET\\COD"

Должно быть

Код:

[Выделить все]

(vl-registry-write "HKEY_CURRENT_USER\\SECRET\\COD1"
(vl-registry-write "HKEY_CURRENT_USER\\SECRET\\COD2"
(vl-registry-write "HKEY_CURRENT_USER\\SECRET\\COD3"

[Дима_]

(if (= t t)
(progn
(princ "aa")
(princ "BB")
)
);end of if

[Red Nova]

Спасибо

[Red Nova]

Обнаружил что программа работает не стабильно.
На некоторых машинах процесс активации проходит гладко, а с некоторыми возникают проблемы.
Вот например. Юзернейм такой.
boris
А командой serial получаю
"nc~e\177HI_EKBGM^IBPP@ECB"
Если перевести командой dserial, то это
"boriP=;;DESIGNKAREN\\\\LION"
Если с этого скомпилировать активационный номер, то в конце проверка показывает что активационный номер не соответствует серийному.
Нет идей?

Код:

[Выделить все]

(defun C:serial (/)
(setq usr (apply 'strcat  (list (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER"))))  
(setq kod (apply 'strcat
                 (mapcar 'chr
                         (mapcar '(lambda (x) (boole 6 x 12))
                                 (vl-string->list usr)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
) ;_ end of defun


(defun C:dserial (/)
 (setq kod (getstring "Введите серийный номер "))
 (setq ret (apply 'strcat
                  (mapcar 'chr (mapcar '(lambda (x) (boole 6 x 12)) (vl-string->list kod)))
           )
 )
)


(defun C:getactivatecode (/)
(setq usr2 (getstring "Введите данные пользователя "))  
(setq kod2 (apply 'strcat
                 (mapcar 'chr
                         (mapcar '(lambda (x) (boole 6 x 10))
                                 (vl-string->list usr2)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
) ;_ end of defun


(defun C:activate (/)
(setq usr (apply 'strcat  (list (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER"))))  
(setq kod2 (apply 'strcat
                 (mapcar 'chr
                         (mapcar '(lambda (x) (boole 6 x 10))
                                 (vl-string->list usr)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
(setq ret2 (getstring "Введите активационный номер "))
(if (= kod2 ret2) 
(progn
 (vl-registry-write "HKEY_CURRENT_USER\\Software\\RED_NOVA_1" "" "******")
 (vl-registry-write "HKEY_CURRENT_USER\\Software\\RED_NOVA_2" "" "*****")
);_end of progn
);_end of if
(princ)
);_ end of defun

Добавлено
Если по очереди выполнить
(getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER")
то получаю "boris" "DESIGNKAREN" "\\\\LION"

[Дима_]

Не проверял но попробуй заменить
(getstring "Введите активационный номер ") на
(getstring "Введите активационный номер " T)

[Red Nova]

Не помогло

[Red Nova]

Люди дорогие, может все же поможите

[VVA]

Red Nova, Я тебя в #28 предупреждал:

(vl-load-com) ;;;=============================================== ;;;Строка в нешифрованном виде (setq usr (getenv "USERNAME")) ;;;=============================================== ;;; Шифруем строку ;;; Применяем операцию XOR ;;; В ф-ции (boole 6 x 12) вместо 12 можно подобрать смещение, ;;; чтобы символы получались из диапазона 30-255 ASCII

Буква s имеет ASCII код - 115
(boole 6 115 12) - вернет 127
По табице ACSII это символ DEL, который не имеет буквенного представления и выдается ввиде номера \127
"nc~e\177HI_EKBGM^IBPP@ECB"
Подбирай другое смещение вместо 12
*** Добавлено
Можно "общаться" не строками, а 16-ричнымм кодами символов, представленными ввиде строки
Как начало, остальное сам по аналогии

Код:

[Выделить все]

;;;============ DecToHex ===============================================
;;;Ф-ция переводит десятичные цифры в шестнадцатиричную систему счисления
;;Dec->Hex
;;;Converting Decimal to Hexadecimal
;;; num - дасятичное число (Decimal number)
;;;Пример (DecToHex 255) -> "FF"
;;;Возвращает шестнадцатиричное число как строку
;;;Алгоритмы конвертации
;;;http://www.iwebtool.com/talk/thread884.html
;;;http://visualcplus.blogspot.com/2006/03/numerical-systems-and-transformations_08.html
(defun DecToHex ( num / dechexlist hexlist Remainder Quotient)
(setq dechexlist '((0 "0")(1 "1")(2 "2")(3 "3")(4 "4")(5 "5")
     (6 "6")(7 "7")(8 "8")(9 "9")(10 "A")(11 "B")
     (12 "C")(13 "D")(14 "E")(15 "F")))
(setq hexlist nil)
(while (not (zerop (setq Quotient (fix (/ num 16)))))
  (setq Remainder (rem num 16)
          hexlist (append hexlist (cdr(assoc Remainder dechexlist)))
        num Quotient))
  (setq hexlist (append hexlist (cdr(assoc num dechexlist))))
  (apply 'strcat (reverse hexlist))
  )
;;======================================================;;
;;  written by Fatty The Old Horse 10/13/05    ;;
;;      (framework)      ;;
;;======================================================;;
;;      helper functions  ;;
;; group list by number
(defun group-by-num (lst num / ls ret)
(if (= (rem (length lst) num ) 0)
 (progn (setq ls nil)
  (repeat (/ (length lst) num)
    (repeat num (setq ls (cons (car lst) ls) lst (cdr lst)))
  (setq ret (append ret (list (reverse ls))) ls nil)))) ret)

;;;============ HexToDec ===============================================
;;;Ф-ция переводит шестнадцатиричные цифры в десятичную систему счисления
;;Hex->Dec
;;;Converting Hexadecimal to Decimal
;;; num - шестнадцатиричное число (Hexadecimal number) as String
;;;Пример (HexToDec "FF") -> 255
;;;       (HexToDec 'FF) -> 255
;;;
;;;http://forum.dwg.ru/showthread.php?t=5589
(defun HexToDec (hexstr / n s i a)
   (setq n 0 i 0)
   (setq hexstr (strcase hexstr))
   (while (> (strlen hexstr) 0)
     (setq s (substr hexstr (strlen hexstr) 1) a (ascii s))
     (cond
      ((<= (ascii "0") a (ascii "9")) (setq a (- a (ascii "0"))))
      ((<= (ascii "A") a (ascii "F")) (setq a (+ 10 (- a (ascii "A")))))
     ) ;; (cond
     (setq n (+ n (* a (expt 16 i))) i (1+ i))
     (setq hexstr (substr hexstr 1 (1- (strlen hexstr))))
   )
   n
  )

(defun C:serial (/)
(setq usr (apply 'strcat  (list (getenv "USERNAME") (getenv "COMPUTERNAME") (getenv "LOGONSERVER"))))  
(setq kod (apply 'strcat
                 (mapcar 'DecToHex
                         (mapcar '(lambda (x) (boole 6 x 12))
                                 (vl-string->list usr)
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
          ) ;_ end of apply
) ;_ end of setq
) ;_ end of defun

(defun C:dserial (/)
 (setq kod (getstring "Введите серийный номер "))
 (setq kod (mapcar 'HexToDec (mapcar '(lambda(x)(apply 'strcat x))(group-by-num (mapcar 'chr (vl-string->list kod)) 2))))
 (setq ret (apply 'strcat
                  (mapcar 'chr (mapcar '(lambda (x) (boole 6 x 12))
                                       kod))
           )
 )
)