Тема: 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.