浮点数与16进制字符串互转
在部分二进制文件中，浮点数是需要转换换为16进制字符串来存储的。
由于在LISP中没有单精度浮点数和双精度浮点数转16进制字符串函数，前些天为此伤透脑筋，有偿悬赏也未有人帮忙解决。
在查阅算法以及论坛资料后，算是完美解决了这个难题。
其中引用了大神baitang36大神的的内部函数itoa，以及高飞鸟大神的激活内部函数的代码，在此拜谢！
程序源代码如下，由于不会使用上传代码工具，敬请谅解
;;=============================================================
;;; 程序加载后，就可以用tranf来激活一个系统隐藏的函数
;;; 用法：(tranf "内部函数名")
;;; 参数：函数名的字符串
;;; 返回：T存在或者是可用的内部函数，nil不存在或则无效
;;; 作者：highflybird
;;; 例子：(tranf "get-logical-drives")
;;; 此程序得到网友baitang36和不死猫的大力帮助，特此致谢！
;;; 另外借鉴了tryhi和其他网友的代码，在此一并感谢！
;;;-------------------------------------------------------------
(defun HFB-LOAD-TRANF (/ f o l s b)
(setq o (strcat (getenv "UserProfile") "\\Intern.fas"))
(if (findfile o)
(vl-file-delete o)
)
(setq l '(70 65 83 52 45 70 73 76 69 13 49 13
49 32 36 1 36 51 51 32 48 32 36 86
58 76 80 80 0 105110116101 1141100
108 11211245 115121109102117 11045 62
97 1080 0 57 3 0 22 36
)
)
(setq b (vlax-make-safearray 17 (cons 0 (1- (length l)))))
(vlax-safearray-fill b l)
(setq s (vlax-create-object "ADODB.Stream"))
(vlax-put s 'type 1)
(vlax-invoke s 'open)
(vlax-invoke-method s 'Write b)
(vlax-invoke s 'saveToFile o 2)
(vlax-invoke s 'close)
(vlax-release-object s)
(mapcar
'set
'(:lpp intern lpp-symfun->al)
(mapcar 'eval (load o))
)
(vl-file-delete o)
(defun tranf (s) (lpp-symfun->al (intern s :lpp)))
(tranf 'al-add-subr-name)
(mapcar
'al-add-subr-name
'(al-add-subr-name lpp-symfun->al intern tranf)
)
(if lpp-symfun->al
(princ "\n已打开内部函数转普通函数大门.\n")
(princ "\n激活内部函数转普通函数失败!\n")
)
)
;激活保留函数功能的自定义函数
(or lpp-symfun->al (HFB-LOAD-TRANF))
;激活itoa进制转换函数(itoa [进制 int])最多32进制
(tranf "itoa")
;字符串分段函数
;参数 str 类型sting
;参数 dimod 当dimod为int时,按int分割(string-Split "asfsgsb" 2)-> '( "as" "fs" gs" b")
;参数 dimod 当dimod为string时,按string 分割(string-Split "assfssgssb" "ss" )-> '( "a" "f" g" b")
(defun string-Split (str dimod / str dimod n nlst)
(if (= (TYPE dimod) 'INT)
(progn
(setq n 1
nlst nil
)
(while (<= n (strlen STR))
(setq nlst (cons (substr str n dimod) nlst))
(setq n (+ n dimod))
)
(reverse nlst)
)
(progn
(while (setq n (vl-string-search dimod str))
(setq nlst (cons (substr str 1 n) nlst)
str(substr str (+ 1 (strlen dimod) n))
)
)
(reverse (cons str nlst))
)
)
)
;二进制字符串转整数
;(2str-to-int "1101")->13
(defun 2str-to-int(str / n int)
(setq n (strlen str) int 0)
(while (/= str "")
(setq n (- n 1))
(if (= "1" (substr str 1 1))
(setq int (+ int (expt 2 n)))
)
(setq str (substr str 2))
)
int
)
;32float2hex单精度浮点数转16进制字符串
;real 单精度浮点数(此处用小数表示)
;(32float2hex 117.1468)->"42EA4B29"
(defun 32float2hex (real / 16str 2str N laststr 2strlst 2strtointlst
16strlst)
(if (equal real 0 0.00000000000001)
(setq 16str "00000000")
(progn
;判断符号位
(if (> real 0)
(setq 2str "0")
(setq 2str "1")
)
(setq real (abs real))
(SETQ N 127)
(WHILE (< 2 REAL)
(SETQ REAL (/ REAL 2.0))
(SETQ N (1+ N))
)
(setq 2str (strcat 2str (itoa n 2))) ;增加阶码位
(setq real (1- real)) ;取尾数部分
(setq laststr "") ;尾数部分二进制初始值
(repeat 23;尾数位数
(setq real (* 2.0 real))
(if (>= real 1)
(progn (setq laststr (strcat laststr "1"))
(setq real (1- real))
)
(setq laststr (strcat laststr "0"))
)
)
(setq 2str (strcat 2str laststr)) ;完整的32位二进制
(setq 2strlst (string-Split 2str 4)) ;每四位分割成表
(setq 2strtointlst (mapcar '2str-to-int 2strlst))
;每四位转换成十进制整数
(setq 16strlst (mapcar '(lambda (X) (itoa x 16)) 2strtointlst))
;每个整数转换为16进制字符串
(setq 16str (strcase(apply 'strcat 16strlst))) ;表中字符串按顺序合并
)
)
)
;64float2hex双精度浮点数转16进制字符串
;real 双精度浮点数(此处用小数表示)
;(64float2hex 117.1468)->"405D49652BD3C361"
(defun 64float2hex (real / 16str 2str N laststr 2strlst 2strtointlst
16strlst)
(if (equal real 0 0.00000000000001)
(setq 16str "0000000000000000")
(progn
;判断符号位
(if (> real 0)
(setq 2str "0")
(setq 2str "1")
)
(setq real (abs real))
(SETQ N 1023)
(WHILE (< 2 REAL)
(SETQ REAL (/ REAL 2.0))
(SETQ N (1+ N))
)
(setq 2str (strcat 2str (itoa n 2))) ;增加阶码位
(setq real (1- real)) ;取尾数部分
(setq laststr "") ;位数部分二进制初始值
(repeat 52
(setq real (* 2.0 real))
(if (>= real 1)
(progn (setq laststr (strcat laststr "1"))
(setq real (1- real))
)
(setq laststr (strcat laststr "0"))
)
)
(setq 2str (strcat 2str laststr)) ;完整的64位二进制
(setq 2strlst (string-Split 2str 4)) ;每四位分割成表
(setq 2strtointlst (mapcar '2str-to-int 2strlst))
;每四位转换成十进制整数
(setq 16strlst (mapcar '(lambda (X) (itoa x 16)) 2strtointlst))
;每个整数转换为16进制字符串
(setq 16str (strcase(apply 'strcat 16strlst))) ;表中字符串按顺序合并
)
)
)
;长度为1的字符串16进制转10进制
(DEFUN 16TO10(str)
(setq str(strcase str))
(ascii "9")
(if(> (ascii str) 57)
(- (ascii str) 55)
(read str)
)
)
;单字节字符串转10进制
(DEFUN byteto10(str)
(setq str(strcase str))
(if (< (strlen str) 2)(setq str (strcat "0" str)))
(+ (* 16 (16TO10 (substr str 1 1))) (16TO10 (substr str 2 1)))
)
;多字节字符串转10进制
(DEFUN bytesto10(str)
(setq lst (mapcar 'byteto10 (string-Split str 2)))
)
;单字符串前面补位0,n补位个数
(DEFUN add0str (str n)
(setq str (strcase str))
(while (< (strlen str) n)
(setq str (strcat "0" str ))
)
str
)
;单字符串后面补位0,n补位个数
(DEFUN addstr0 (str n)
(setq str (strcase str))
(while (< (strlen str) n)
(setq str (strcatstr "0"))
)
str
)
;两个常规字符代表一个字节，不足前面补0
(defun onebytes(str)
(if (/= (strlen str) 2)(add0str str 2)str)
)
;64hex2float 64位16进制字符串转双精度浮点数
;str 长度位16的字符串
;(64hex2float "405D49652BD3C361")->"117.1468"
(defun 64hex2float (str / 2lst 2str fhw zsw wsw zsm ws wswlst)
(setq lst (mapcar '16TO10 (string-Split str 1)))
(setq 2lst (mapcar '(lambda (X) (add0str (itoa x 2) 4)) lst))
(setq 2str (apply 'strcat 2lst))
(setq fhw (substr 2str 1 1))
(setq zsw (substr 2str 2 11))
(setq wsw (substr 2str 13 52))
(setq zsm (- (2str-to-int zsw) 1023))
(setq ws 0.000000000000001)
(setq wswlst (reverse (string-split wsw 1)))
(while wswlst
(if (= "1" (car wswlst))
(setq ws (/ (1+ ws) 2.0))
(setq ws (/ ws 2.0))
)
(if (> ws 1)
(setq ws (- ws 1))
)
(setq wswlst (cdr wswlst))
)
(if (= "1" fhw)
(- 0 (* (+ 1 ws) (expt 2 zsm)))
(* (+ 1 ws) (expt 2 zsm))
)
)
;32hex2float 32位16进制字符串转双精度浮点数
;str 长度位8的字符串
;(32hex2float "42EA4B29")->"117.1468"
(defun 32hex2float (str / 2lst 2str fhw zsw wsw zsm ws wswlst)
(setq lst (mapcar '16TO10 (string-Split str 1)))
(setq 2lst (mapcar '(lambda (X) (add0str (itoa x 2) 4)) lst))
(setq 2str (apply 'strcat 2lst))
(setq fhw (substr 2str 1 1))
(setq zsw (substr 2str 2 8))
(setq wsw (substr 2str 10 23))
(setq zsm (- (2str-to-int zsw) 127))
(setq ws 0.0000001)
(setq wswlst (reverse (string-split wsw 1)))
(while wswlst
(if (= "1" (car wswlst))
(setq ws (/ (1+ ws) 2.0))
(setq ws (/ ws 2.0))
)
(if (> ws 1)
(setq ws (- ws 1))
)
(setq wswlst (cdr wswlst))
)
(if (= "1" fhw)
(- 0 (* (+ 1 ws) (expt 2 zsm)))
(* (+ 1 ws) (expt 2 zsm))
)
)
;;=============================================================
;;; 程序加载后，就可以用tranf来激活一个系统隐藏的函数
;;; 用法：(tranf "内部函数名")
;;; 参数：函数名的字符串
;;; 返回：T存在或者是可用的内部函数，nil不存在或则无效
;;; 作者：highflybird
;;; 例子：(tranf "get-logical-drives")
;;; 此程序得到网友baitang36和不死猫的大力帮助，特此致谢！
;;; 另外借鉴了tryhi和其他网友的代码，在此一并感谢！
;;;-------------------------------------------------------------
(defun HFB-LOAD-TRANF (/ f o l s b)
(setq o (strcat (getenv "UserProfile") "\\Intern.fas"))
(if (findfile o)
(vl-file-delete o)
)
(setq l '(70 65 83 52 45 70 73 76 69 13 49 13
49 32 36 1 36 51 51 32 48 32 36 86
58 76 80 80 0 105110116101 1141100
108 11211245 115121109102117 11045 62
97 1080 0 57 3 0 22 36
)
)
(setq b (vlax-make-safearray 17 (cons 0 (1- (length l)))))
(vlax-safearray-fill b l)
(setq s (vlax-create-object "ADODB.Stream"))
(vlax-put s 'type 1)
(vlax-invoke s 'open)
(vlax-invoke-method s 'Write b)
(vlax-invoke s 'saveToFile o 2)
(vlax-invoke s 'close)
(vlax-release-object s)
(mapcar
'set
'(:lpp intern lpp-symfun->al)
(mapcar 'eval (load o))
)
(vl-file-delete o)
(defun tranf (s) (lpp-symfun->al (intern s :lpp)))
(tranf 'al-add-subr-name)
(mapcar
'al-add-subr-name
'(al-add-subr-name lpp-symfun->al intern tranf)
)
(if lpp-symfun->al
(princ "\n已打开内部函数转普通函数大门.\n")
(princ "\n激活内部函数转普通函数失败!\n")
)
)
;激活保留函数功能的自定义函数
(or lpp-symfun->al (HFB-LOAD-TRANF))
;激活itoa进制转换函数(itoa [进制 int])最多32进制
(tranf "itoa")
;字符串分段函数
;参数 str 类型sting
;参数 dimod 当dimod为int时,按int分割(string-Split "asfsgsb" 2)-> '( "as" "fs" gs" b")
;参数 dimod 当dimod为string时,按string 分割(string-Split "assfssgssb" "ss" )-> '( "a" "f" g" b")
(defun string-Split (str dimod / str dimod n nlst)
(if (= (TYPE dimod) 'INT)
(progn
(setq n 1
nlst nil
)
(while (<= n (strlen STR))
(setq nlst (cons (substr str n dimod) nlst))
(setq n (+ n dimod))
)
(reverse nlst)
)
(progn
(while (setq n (vl-string-search dimod str))
(setq nlst (cons (substr str 1 n) nlst)
str(substr str (+ 1 (strlen dimod) n))
)
)
(reverse (cons str nlst))
)
)
)
;二进制字符串转整数
;(2str-to-int "1101")->13
(defun 2str-to-int(str / n int)
(setq n (strlen str) int 0)
(while (/= str "")
(setq n (- n 1))
(if (= "1" (substr str 1 1))
(setq int (+ int (expt 2 n)))
)
(setq str (substr str 2))
)
int
)
;32float2hex单精度浮点数转16进制字符串
;real 单精度浮点数(此处用小数表示)
;(32float2hex 117.1468)->"42EA4B29"
(defun 32float2hex (real / 16str 2str N laststr 2strlst 2strtointlst
16strlst)
(if (equal real 0 0.00000000000001)
(setq 16str "00000000")
(progn
;判断符号位
(if (> real 0)
(setq 2str "0")
(setq 2str "1")
)
(setq real (abs real))
(SETQ N 127)
(WHILE (< 2 REAL)
(SETQ REAL (/ REAL 2.0))
(SETQ N (1+ N))
)
(setq 2str (strcat 2str (itoa n 2))) ;增加阶码位
(setq real (1- real)) ;取尾数部分
(setq laststr "") ;尾数部分二进制初始值
(repeat 23;尾数位数
(setq real (* 2.0 real))
(if (>= real 1)
(progn (setq laststr (strcat laststr "1"))
(setq real (1- real))
)
(setq laststr (strcat laststr "0"))
)
)
(setq 2str (strcat 2str laststr)) ;完整的32位二进制
(setq 2strlst (string-Split 2str 4)) ;每四位分割成表
(setq 2strtointlst (mapcar '2str-to-int 2strlst))
;每四位转换成十进制整数
(setq 16strlst (mapcar '(lambda (X) (itoa x 16)) 2strtointlst))
;每个整数转换为16进制字符串
(setq 16str (strcase(apply 'strcat 16strlst))) ;表中字符串按顺序合并
)
)
)
;64float2hex双精度浮点数转16进制字符串
;real 双精度浮点数(此处用小数表示)
;(64float2hex 117.1468)->"405D49652BD3C361"
(defun 64float2hex (real / 16str 2str N laststr 2strlst 2strtointlst
16strlst)
(if (equal real 0 0.00000000000001)
(setq 16str "0000000000000000")
(progn
;判断符号位
(if (> real 0)
(setq 2str "0")
(setq 2str "1")
)
(setq real (abs real))
(SETQ N 1023)
(WHILE (< 2 REAL)
(SETQ REAL (/ REAL 2.0))
(SETQ N (1+ N))
)
(setq 2str (strcat 2str (itoa n 2))) ;增加阶码位
(setq real (1- real)) ;取尾数部分
(setq laststr "") ;位数部分二进制初始值
(repeat 52
(setq real (* 2.0 real))
(if (>= real 1)
(progn (setq laststr (strcat laststr "1"))
(setq real (1- real))
)
(setq laststr (strcat laststr "0"))
)
)
(setq 2str (strcat 2str laststr)) ;完整的64位二进制
(setq 2strlst (string-Split 2str 4)) ;每四位分割成表
(setq 2strtointlst (mapcar '2str-to-int 2strlst))
;每四位转换成十进制整数
(setq 16strlst (mapcar '(lambda (X) (itoa x 16)) 2strtointlst))
;每个整数转换为16进制字符串
(setq 16str (strcase(apply 'strcat 16strlst))) ;表中字符串按顺序合并
)
)
)
;长度为1的字符串16进制转10进制
(DEFUN 16TO10(str)
(setq str(strcase str))
(ascii "9")
(if(> (ascii str) 57)
(- (ascii str) 55)
(read str)
)
)
;单字节字符串转10进制
(DEFUN byteto10(str)
(setq str(strcase str))
(if (< (strlen str) 2)(setq str (strcat "0" str)))
(+ (* 16 (16TO10 (substr str 1 1))) (16TO10 (substr str 2 1)))
)
;多字节字符串转10进制
(DEFUN bytesto10(str)
(setq lst (mapcar 'byteto10 (string-Split str 2)))
)
;单字符串前面补位0,n补位个数
(DEFUN add0str (str n)
(setq str (strcase str))
(while (< (strlen str) n)
(setq str (strcat "0" str ))
)
str
)
;单字符串后面补位0,n补位个数
(DEFUN addstr0 (str n)
(setq str (strcase str))
(while (< (strlen str) n)
(setq str (strcatstr "0"))
)
str
)
;两个常规字符代表一个字节，不足前面补0
(defun onebytes(str)
(if (/= (strlen str) 2)(add0str str 2)str)
)
;64hex2float 64位16进制字符串转双精度浮点数
;str 长度位16的字符串
;(64hex2float "405D49652BD3C361")->"117.1468"
(defun 64hex2float (str / 2lst 2str fhw zsw wsw zsm ws wswlst)
(setq lst (mapcar '16TO10 (string-Split str 1)))
(setq 2lst (mapcar '(lambda (X) (add0str (itoa x 2) 4)) lst))
(setq 2str (apply 'strcat 2lst))
(setq fhw (substr 2str 1 1))
(setq zsw (substr 2str 2 11))
(setq wsw (substr 2str 13 52))
(setq zsm (- (2str-to-int zsw) 1023))
(setq ws 0.000000000000001)
(setq wswlst (reverse (string-split wsw 1)))
(while wswlst
(if (= "1" (car wswlst))
(setq ws (/ (1+ ws) 2.0))
(setq ws (/ ws 2.0))
)
(if (> ws 1)
(setq ws (- ws 1))
)
(setq wswlst (cdr wswlst))
)
(if (= "1" fhw)
(- 0 (* (+ 1 ws) (expt 2 zsm)))
(* (+ 1 ws) (expt 2 zsm))
)
)
;32hex2float 32位16进制字符串转双精度浮点数
;str 长度位8的字符串
;(32hex2float "42EA4B29")->"117.1468"
(defun 32hex2float (str / 2lst 2str fhw zsw wsw zsm ws wswlst)
(setq lst (mapcar '16TO10 (string-Split str 1)))
(setq 2lst (mapcar '(lambda (X) (add0str (itoa x 2) 4)) lst))
(setq 2str (apply 'strcat 2lst))
(setq fhw (substr 2str 1 1))
(setq zsw (substr 2str 2 8))
(setq wsw (substr 2str 10 23))
(setq zsm (- (2str-to-int zsw) 127))
(setq ws 0.0000001)
(setq wswlst (reverse (string-split wsw 1)))
(while wswlst
(if (= "1" (car wswlst))
(setq ws (/ (1+ ws) 2.0))
(setq ws (/ ws 2.0))
)
(if (> ws 1)
(setq ws (- ws 1))
)
(setq wswlst (cdr wswlst))
)
(if (= "1" fhw)
(- 0 (* (+ 1 ws) (expt 2 zsm)))
(* (+ 1 ws) (expt 2 zsm))
)
) 这么好的函数居然没评论
页:
[1]