cabinsummer的留言板 - 明经CAD社区

cabinsummer 2021-10-22 14:55

(defun MD5 (String / lst a b c d f g h i k l r w x y)
  (setq lst (StringToAscii String))
  (setq k
(mapcar
   '(lambda (x) (md5:int->bits x 32))
   '(
      3614090360 3905402710 0606105819 3250441966 4118548399 1200080426 2821735955 4249261313
      1770035416 2336552879 4294925233 2304563134 1804603682 4254626195 2792965006 1236535329
      4129170786 3225465664 0643717713 3921069994 3593408605 0038016083 3634488961 3889429448
      0568446438 3275163606 4107603335 1163531501 2850285829 4243563512 1735328473 2368359562
      4294588738 2272392833 1839030562 4259657740 2763975236 1272893353 4139469664 3200236656
      0681279174 3936430074 3572445317 0076029189 3654602809 3873151461 0530742520 3299628645
      4096336452 1126891415 2878612391 4237533241 1700485571 2399980690 4293915773 2240044497
      1873313359 4264355552 2734768916 1309151649 4149444226 3174756917 0718787259 3951481745
   )
)
  )
  (setq r
'(
   07 12 17 22  07 12 17 22  07 12 17 22  07 12 17 22
   05 09 14 20  05 09 14 20  05 09 14 20  05 09 14 20
   04 11 16 23  04 11 16 23  04 11 16 23  04 11 16 23
   06 10 15 21  06 10 15 21  06 10 15 21  06 10 15 21
)
  )
  (setq h
(mapcar
   '(lambda (x) (md5:int->bits x 32))
   '(
      1732584193
      4023233417
      2562383102
      0271733878
   )
)
  )
  (setq l (cons 128 (reverse lst)))
  (repeat (rem (+ 64 (- 56 (rem (length l) 64))) 64) (setq l (cons 0 l)))
  (setq l (append (reverse l) (md5:bits->bytes (md5:int->bits (* 8 (length lst)) 64))))
  (repeat (/ (length l) 64)
(repeat 16
   (setq w (cons (md5:bytes->bits (mapcar '+ l '(0 0 0 0))) w)
         l (cddddr l)
   )
)
(setq w (reverse w))
(mapcar 'set '(a b c d) h)
(setq i 0)
(repeat 64
   (cond
      (
      (< i 16)
      (setq f (mapcar 'logior (mapcar 'logand b c)(mapcar 'logand (mapcar '(lambda (a)(+ 2 (~ a))) b) d))
            g i
      )
      )
      (
      (< i 32)
      (setq f (mapcar 'logior (mapcar 'logand d b) (mapcar 'logand (mapcar '(lambda ( a ) (+ 2 (~ a))) d) c))
            g (rem (1+ (* 5 i)) 16)
      )
      )
      (
      (< i 48)
      (setq f (mapcar '(lambda ( a b c ) (boole 6 a b c)) b c d)
            g (rem (+ 5 (* 3 i)) 16)
      )
      )
      (
      (setq f (mapcar '(lambda ( a b ) (boole 6 a b)) c (mapcar 'logior b (mapcar '(lambda ( a ) (+ 2 (~ a))) d)))
            g (rem (* 7 i) 16)
      )
      )
   )
   (mapcar 'set '(d c a b i)
            (list c b d
                  (md5:uint32_+ b
                  (md5:leftrotate
                     (md5:uint32_+
                        (md5:uint32_+
                        (md5:uint32_+ a f)
                        (nth i k)
                        )
                        (nth g w)
                     )
                     (nth i r)
                  )
                  )
                  (1+ i)
            )
   )
)
(setq h (mapcar 'md5:uint32_+ h (list a b c d))
      w nil
)
  )
  (apply 'strcat (mapcar 'md5:byte->hex (apply 'append (mapcar 'md5:bits->bytes h))))
)

(defun StringToAscii (String / positioni YPOutString)
  (setq positioni -1)
  (repeat (strlen string)
(setq YPOutString (append YPOutString (list (vl-string-elt string (setq positioni (+ positioni 1))))))
  )
  YPOutString
)

(defun md5:int->bits (n b / l x)
  (repeat b (setq l (cons 0 l)))
  (foreach x (vl-string->list (rtos n 2 0))
(setq x (- x 48)
      l (mapcar '(lambda ( a ) (setq a (+ (* a 10) x) x (/ a 2)) (rem a 2)) l)
)
  )
  (reverse l)
)

(defun md5:bits->int (l)
  (
(lambda (f)(f (reverse l)))
(lambda (l) (if l (+ (* 2.0 (f (cdr l))) (car l)) 0))
  )
)

(defun md5:bits->bytes (l / b r)
  (repeat (/ (length l) 8)
(repeat 8
   (setq b (cons (car l) b)
         l (cdr l)
   )
)
(setq r (cons (fix (+ 1e-8 (md5:bits->int (reverse b)))) r)
      b nil
)
  )
  r
)

(defun md5:bytes->bits (l)
  (apply 'append (mapcar '(lambda ( b ) (md5:int->bits b 8)) (reverse l)))
)

(defun md5:int->char (n)
  (chr (+ n (if (< n 10) 48 55)))
)

(defun md5:byte->hex (x)
  (strcat (md5:int->char (/ x 16)) (md5:int->char (rem x 16)))
)

(defun md5:leftrotate (l x)
  (repeat x (setq l (append (cdr l) (list (car l)))))
)

(defun md5:uint32_+ (bl1 bl2 / r)
  (setq r 0)
  (reverse
(mapcar
   '(lambda (a b c / x)
      (setq x (boole 6 (boole 6 a b) r)
            r (boole 7 (boole 1 a b) (boole 1 a r) (boole 1 b r))
      )
      x
   )
   (append (reverse bl1) (md5:uint32_0))
   (append (reverse bl2) (md5:uint32_0))
   (md5:uint32_0)
)
  )
)

(defun md5:uint32_0 (/ l)
  (repeat 32 (setq l (cons 0 l)))
  (eval (list 'defun 'md5:uint32_0 nil (list 'quote l)))
  (md5:uint32_0)
)