分享一个获取网络时间的源码
本帖最后由 baitang36 于 2023-5-12 16:34 编辑从一个软件中挖出来的，可能是lee-mac写的。
用法：(NETTIME "yymodd")
(NETTIME "yymoddhhmmss")
返回的时间是UTC时间，北京时间需要加8小时。
(NETTIME "yyyymodd")
"20230512"
(DEFUN JTOY (J / A B C D)
(setq J (FIX J))
(setq A (FIX (/ (- J 1867216.25) 36524.25)))
(setq B (+ (- (+ J 1 A) (FIX (/ A 4))) 1524))
(setq C (FIX (/ (- B 122.1) 365.25)))
(setq D (FIX (/ (- B (FIX (* 365.25 C))) 30.6001)))
(FIX (- C
(if (< 2
(FIX (if (< D 14)
(PROGN (1- D))
(PROGN (- D 13))
) ;_ if
) ;_ FIX
) ;_ <
(PROGN 4716)
(PROGN 4715)
) ;_ if
) ;_ -
) ;_ FIX
) ;_ DEFUN
(DEFUN NETTIME (FORMAT / RESULT RGX SERVER XML)
(setq SERVER "http://time.nist.gov:13")
(setq RESULT
(VL-CATCH-ALL-APPLY
'(lambda (/ STR)
(setq XML (vlax-create-object "MSXML2.XMLHTTP.3.0"))
(setq RGX (vlax-create-object "vbscript.regexp"))
(vlax-invoke-method XML 'OPEN "POST" SERVER :vlax-false)
(vlax-invoke-method XML 'SEND)
(if (setq STR (vlax-get-property XML 'RESPONSETEXT))
(PROGN
(vlax-put-property RGX 'GLOBAL acTrue)
(vlax-put-property RGX 'IGNORECASE acTrue)
(vlax-put-property RGX 'MULTILINE acTrue)
(setq STR
(STRCAT
" "
(ITOA
(JTOY (+ (ATOI (SUBSTR STR 2 5)) 2400000.5)
) ;_ JTOY
) ;_ ITOA
(SUBSTR STR 7)
) ;_ STRCAT
) ;_ setq
(MAPCAR '(lambda (A B)
(vlax-put-property RGX 'PATTERN A)
(setq
FORMAT (vlax-invoke RGX 'REPLACE FORMAT B)
) ;_ setq
) ;_ lambda
'("YYYY" "YY" "MO" "DD" "HH" "MM" "SS")
'("$1" "$2" "$3" "$4" "$5" "$6" "$7")
) ;_ MAPCAR
(vlax-put-property
RGX
'PATTERN
(STRCAT "(?:[^\\d]+)([\\d]+)(?:[^\\d]+)([\\d]+)"
"(?:[^\\d]+)([\\d]+)(?:[^\\d]+)([\\d]+)"
"(?:[^\\d]+)([\\d]+)(?:[^\\d]+)([\\d]+)"
"(?:[^\\d]+)([\\d]+)(?:.+)\\n"
) ;_ STRCAT
) ;_ vlax-put-property
(vlax-invoke-method RGX 'REPLACE STR FORMAT)
) ;_ PROGN
) ;_ if
) ;_ lambda
) ;_ VL-CATCH-ALL-APPLY
) ;_ setq
(if XML
(PROGN (vlax-release-object XML))
) ;_ if
(if RGX
(PROGN (vlax-release-object RGX))
) ;_ if
(if (VL-CATCH-ALL-ERROR-P RESULT)
(PROGN (PROMPT (VL-CATCH-ALL-ERROR-MESSAGE RESULT)))
(PROGN RESULT)
) ;_ if
) ;_ DEFUN
罗尼 发表于 2023-5-12 16:09
命令: (NETTIME "yymodd")
Automation 错误。 指定资源下载失败。
nil
windows的对时就是用的这个服务器http://time.nist.gov 本帖最后由 cchessbd 于 2023-5-15 08:18 编辑
baitang36 发表于 2023-5-15 08:06
http://bbs.mjtd.com/thread-186195-1-1.html
哦，原来老师早就写过了。。。
我下载是论坛另一位发布的源码，我再研究下您的。您这个win7也可以获取。
之前我修改的部分是，应对没有网络（或网卡被禁用）的情况。
baitang36 发表于 2023-5-15 08:06
http://bbs.mjtd.com/thread-186195-1-1.html
经过测试，这个版本没有需要curl的好。估计采用curl的原因就是每次运行都能实时获取文件。
这个版本在time1.htm文件没有的情况下就出错了。 命令: (NETTIME "yymodd")
Automation 错误。 指定资源下载失败。
nil 少了一个函数：no function definition: JTOY ssyfeng 发表于 2023-5-12 16:25
少了一个函数：no function definition: JTOY
加上了，多谢提醒。 谢谢分享很实用 这个不稳定，有时候能获取到，有时候是nil。
而且速度很慢。等我有时间来研究研究。 路过支持！ cchessbd 发表于 2023-5-13 07:28
这个不稳定，有时候能获取到，有时候是nil。
而且速度很慢。等我有时间来研究研究。
兄弟，等你哈 本帖最后由 cchessbd 于 2023-5-15 07:46 编辑
刚刚在win7下测试，获取不到，可能只有win10才能运行。。。
目前速度最快的，获取网络时间源码。取之于明，用之于明。
本人稍微修改了下，CAD2008测试多次都没问题。
页:
[1]
2