分享一个获取网络时间的源码

baitang36

从一个软件中挖出来的，可能是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

baitang36

罗尼 发表于 2023-5-12 16:09
命令: (NETTIME "yymodd")
Automation 错误。 指定资源下载失败。
nil

windows的对时就是用的这个服务器  http://time.nist.gov

cchessbd

baitang36 发表于 2023-5-15 08:06
http://bbs.mjtd.com/thread-186195-1-1.html

哦，原来老师早就写过了。。。
我下载是论坛另一位发布的源码，我再研究下您的。您这个win7也可以获取。
之前我修改的部分是，应对没有网络（或网卡被禁用）的情况。

cchessbd

baitang36 发表于 2023-5-15 08:06
http://bbs.mjtd.com/thread-186195-1-1.html

经过测试，这个版本没有需要curl的好。估计采用curl的原因就是每次运行都能实时获取文件。

这个版本在time1.htm文件没有的情况下就出错了。

罗尼

命令: (NETTIME "yymodd")
Automation 错误。 指定资源下载失败。
nil

ssyfeng

少了一个函数：no function definition: JTOY

baitang36

ssyfeng 发表于 2023-5-12 16:25
少了一个函数：no function definition: JTOY

加上了，多谢提醒。

xudongchu

谢谢分享  很实用

cchessbd

这个不稳定，有时候能获取到，有时候是nil。
而且速度很慢。等我有时间来研究研究。

Noangler

路过支持！

zj20190405

cchessbd 发表于 2023-5-13 07:28
这个不稳定，有时候能获取到，有时候是nil。
而且速度很慢。等我有时间来研究研究。

兄弟，等你哈

cchessbd

刚刚在win7下测试，获取不到，可能只有win10才能运行。。。

目前速度最快的，获取网络时间源码。取之于明，用之于明。

本人稍微修改了下，CAD2008测试多次都没问题。