|
;;---------------------=={ Internet Time }==------------------;;
;; ;;
;; Returns the date and/or UTC time as a string in the ;;
;; format specified. Data is sourced from a NIST server. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - [url]www.lee-mac.com[/url] ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; format - string specifying format of returned information ;;
;; using the following identifiers to represent ;;
;; date & time quantities: ;;
;; YY = Year, MO = Month, DD = Day ;;
;; HH = Hour, MM = Minutes, SS = Seconds ;;
;;------------------------------------------------------------;;
;; Returns: String containing formatted date/time data ;;
;;------------------------------------------------------------;;
(defun LM:InternetTime ( format / result rgx server xml )
(setq server "http://time.nist.gov:13")
(setq result
(vl-catch-all-apply
(function
(lambda ( / cmd cnt 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)
(setq cnt 0)
(while (and (/= 4 (vlax-get-property xml 'readystate)) (< (setq cnt (1+ cnt)) 10))
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.delay" 1000)
(setvar 'cmdecho cmd)
)
(if (and (< cnt 10) (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)
(mapcar
(function
(lambda ( a b )
(vlax-put-property rgx 'pattern a)
(setq format (vlax-invoke rgx 'replace format b))
)
)
'("YY" "MO" "DD" "HH" "MM" "SS")
'("$1" "$2" "$3" "$4" "$5" "$6")
)
(vlax-put-property rgx 'pattern
(strcat
"(?:[^\\d]+[\\d]+[^\\d]+)"
"([\\d]+)(?:[^\\d]+)([\\d]+)(?:[^\\d]+)([\\d]+)(?:[^\\d]+)"
"([\\d]+)(?:[^\\d]+)([\\d]+)(?:[^\\d]+)([\\d]+)(?:.+)\\n"
)
)
(vlax-invoke-method rgx 'replace str format)
)
)
)
)
)
)
(if xml (vlax-release-object xml))
(if rgx (vlax-release-object rgx))
(if (not (vl-catch-all-error-p result))
result
)
) |
|