1

Тема: NewLISP: скрипт получения курсов валют с сайта ЦБ

(import "user32.dll" "CharToOemA")
(import "user32.dll" "OemToCharA")

(set-locale "russian")

(setq base_url   "http://www.cbr.ru/scripts/XML_daily.asp?date_req="
      arrParams  '("CharCode" "Name" "Value")
      vals       (2 (main-args)))

(define (WinDos in direct)
   (letn (out (dup "\000" (length in)))
         (if (= ((if direct CharToOemA OemToCharA) in out) 1) out)) )

(define (load_val base-url dateval)
   (when (starts-with
            (setq xml_src (WinDos (get-url (setq url (append base-url (date dateval 0 "%d.%m.%Y"))) nil 10000) true))
            "ERR:")
         (println " ошибка загрузки " url ". (" ((regex ".+$" xml_src) 0) ")") (exit))
   (xml-type-tags nil nil nil nil)
   (setq sxml (xml-parse xml_src (+ 1 2 4 16)) )
   (list sxml (sxml -1 1 1 -1)) )

(define (scan-xml sx)
   (if (list? sx)
      (if (= (length sx) 1)
          (scan-xml (first sx))
          (filter (fn (x) (and (if (list? x) (not (empty? x)))
                               (not (nil? x)) ) )
             (map (fn (x) (if (and (list? x) (not (empty? x)) )
                              (if (if (symbol? (x 0))
                                      (find (name (x 0)) arrParams)
                                      (find (x 0) arrParams))
                                  x
                                  (scan-xml x))))
                 sx)))) )

(define (fltval x)
    (if (empty? vals)
        true
        (if (symbol? (last (x 0)))
            (find (name (last (x 0))) vals (fn (x y) (= (upper-case x) (upper-case y))) )
            (find (last (x 0))        vals (fn (x y) (= (upper-case x) (upper-case y))))) ) )

(define (print_val dateval x)
   (print "\n" dateval "\n" "--------------------------------------------------\n"
                            "| Код | Наименование                   |  Курс   |\n"
                            "--------------------------------------------------\n")
   (map (fn (y) (println
                    (format "| %-4s| %-000000000000000000000030.30s | %00007s | " (list (y 0 -1)
                                                                                        (append (y 1 -1) " " (dup "." 100))
                                                                                        (replace "," (y 2 -1) "."))))) x)
   (println                 "--------------------------------------------------") )

(print "Загрузка курсов с " ( (regex "(http://)?(.*?)/" base_url) (* 2 3) ) " ... ")

(setq xml_and_dateC (load_val base_url (date-value) ) )

(when (nil? (regex "([0-9][0-9]?)\.([0-9][0-9]?)\.(([0-9][0-9])?[0-9][0-9])" (xml_and_dateC -1) 16))
      (println "В загруженном документе дата не найдена. Выходим.") (exit))

(setq xml_and_dateB (load_val base_url (- (date-value (int $3) (int $2) (int $1) 1 0 0) (* 3600 24) ) ))

(setq vsB (filter fltval (scan-xml (first xml_and_dateB)) )
      vsC (filter fltval (scan-xml (first xml_and_dateC)) ))

(print "\r" (dup " " 50) "\r")

(print_val (append "Запрошенные курсы на дату: " (xml_and_dateB -1)) vsB)
(print_val (append (if (= (date (date-value) 0 "%d.%m.%Y") (xml_and_dateC -1))
                       "Запрошенные курсы на дату: "
                       "Существуют курсы только на дату: ")
                   (xml_and_dateC -1)) vsC)

Скрипт выводит две таблички с курсами валют - курсы за вчерашнюю и за сегодняшнюю дату. Если сегодня курсов еще нет (так бывает по понедельникам - в понедельник действует субботний курс ЦБ), то выводится последний имеющийся курс и за предыдущую дату относительно имеющегося.

Запуск:

"C:\Program Files\newlisp\newlisp.exe" Currency.lsp

Можно фильтровать список валют, передавая их буквенные коды в виде параметров:

"C:\Program Files\newlisp\newlisp.exe" Currency.lsp USD EUR

Заодно в коде есть пример импорта и использования функции из DLL.