[编程交流] 通过LISP连接到Web服务器

;;---------------------=={ 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="http://www.lee-mac.com"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  format - string specifying format of returned information ;;
;;           using the following identifiers to represent     ;;
;;           date & time quantities:                          ;;
;;           YYYY = 4-digit year                              ;;
;;           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 "[url]http://time.nist.gov:13[/url]")
   (setq result
       (vl-catch-all-apply
           (function
               (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))) (substr str 7)))
                           (mapcar
                               (function
                                   (lambda ( a b )
                                       (vlax-put-property rgx 'pattern a)
                                       (setq format (vlax-invoke rgx 'replace format b))
                                   )
                               )
                              '("YYYY" "YY" "MO" "DD" "HH" "MM" "SS")
                              '( "$1"  "$2" "$3" "$4" "$5" "$6" "$7")
                           )
                           (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 (vl-catch-all-error-p result)
       (prompt (vl-catch-all-error-message result))
       result
   )
)
;; Julian Date to Calendar Year - Lee Mac
;; Algorithm from: Meeus, Jean.  Astronomical Algorithms.
(defun jtoy ( j / a b c d )
   (setq j (fix j)
         a (fix (/ (- j 1867216.25) 36524.25))
         b (+ (- (+ j 1 a) (fix (/ a 4))) 1524)
         c (fix (/ (- b 122.1) 365.25))
         d (fix (/ (- b (fix (* 365.25 c))) 30.6001))
   )
   (fix (- c (if (< 2 (fix (if (< d 14) (1- d) (- d 13)))) 4716 4715)))
)
(vl-load-com) (princ)

(defun pingserver ( / xml str)
(setq server "http://thirdistudio.com.au/TestInfo.txt") ; I would change this to get passed a unique filename
(setq xml (vlax-create-object "MSXML2.XMLHTTP.3.0"))
(vlax-invoke-method xml 'open "POST" server :vlax-false)
(vlax-invoke-method xml 'send)
(setq str (vlax-get-property xml 'responsetext))
; got your file !!!!!
;do your bit here
(if xml  (vlax-release-object xml))
)