Утилита для получения курсов валют с сайта www.cbr.ru

Написана для поддержания работы старой софтины на FPD2.6
[code] * ПОЛУЧЕНИЕ КУРСОВ ВАЛЮТ ЗА ПЕРИОД С САЙТА WWW.CBR.RU * ОПИСАНИЕ : http://www.cbr.ru/scripts/Root.asp?Prtid=SXML * ЗАГРУЗКА : http://www.cbr.ru/scripts/XML_daily.asp?date_req=02/03/2002 * СТРУКТУРА XML ФАЙЛА МОЖЕТ БЫТЬ ИЗМЕНЕНА ЦБ БЕЗ ПРЕДУПРЕЖДЕНИЯ 😉 LPARAMETERS tuBeg AS Variant, tuEnd AS Variant, tuPath AS Variant,; tuStub1 AS Variant, tuStub2 AS Variant, tuStub3 AS Variant, tuStub4 AS Variant, tuStub5 AS Variant LOCAL loException AS Exception, ldBeg AS Datetime, ldEnd AS Datetime, ldCur AS Date, lnDay AS Integer,; lcAddress AS String, lcXMLFile AS String, lnSuccess AS Integer, lnSum AS Decimal, lcPath AS String #DEFINE APP_NAME 'Загрузка курсов валют с сайта WWW.CBR.RU' #DEFINE CHR_CR CHR(13) #DEFINE CHR_CR2 CHR(13) + CHR(13) #DEFINE CHR_TAB CHR(09) lnSuccess = 0 TRY ON SHUTDOWN QUIT * СДЕЛАЕМ ТЕКУЩИМ СТАРТОВЫЙ КАТАЛОГ Application.DefaultFilePath = ADDBS(JUSTPATH(SYS(16, PROGRAM(-1)))) tuBeg = TRANSFORM(tuBeg) tuEnd = TRANSFORM(tuEnd) ldBeg = TTOD(CTOT(LEFT(tuBeg, 4) + '-' + SUBSTR(tuBeg, 5, 2) + '-' + SUBSTR(tuBeg, 7, 2)+'T')) ldEnd = TTOD(CTOT(LEFT(tuEnd, 4) + '-' + SUBSTR(tuEnd, 5, 2) + '-' + SUBSTR(tuEnd, 7, 2)+'T')) lcPath = IIF(VARTYPE(tuPath) = 'C' AND !EMPTY(tuPath), ADDBS(ALLTRIM(tuPath)), '') DO CASE CASE PCOUNT() = 0 MESSAGEBOX('Параметры : даты начала и окончания в виде ГГГГММДД' + CHR_CR2 +; 'Пример применения : currency.exe ' + DTOS(DATE() - DAY(DATE()) + 1) + ' ' +; DTOS(GOMO(DATE() - DAY(DATE()) + 1, 1) - 1), 64, APP_NAME) CASE !IsInternetConnected() MESSAGEBOX('Компьютер не подключен к интернету', 48, APP_NAME) CASE PCOUNT() = 1 MESSAGEBOX('Не задана дата окончания периода', 48, APP_NAME) CASE EMPTY(ldBeg) AND EMPTY(ldEnd) MESSAGEBOX('Неверные даты в периоде : ' + tuBeg + ' ' + tuEnd, 48, APP_NAME) CASE EMPTY(ldBeg) MESSAGEBOX('Неверная дата начала периода : ' + tuBeg, 48, APP_NAME) CASE EMPTY(ldEnd) MESSAGEBOX('Неверная дата окончания периода : ' + tuEnd, 48, APP_NAME) CASE ldBeg > ldEnd MESSAGEBOX('Дата начала периода позже даты окончания', 48, APP_NAME) CASE !EMPTY(lcPath) AND !DIRECTORY(lcPath) MESSAGEBOX('Не найден каталог' + CHR_CR2 + lcPath, 48, APP_NAME) OTHERWISE IF USED('Currency') * ВЫБЕРЕМ АЛИАС SELECT Currency SET ORDER TO Date ELSE IF !FILE(lcPath + 'Currency.dbf') * СОЗДАДИМ КУРСОР CREATE CURSOR Currency (Date D, Code N(3), Quant N(9), Sum N(11,4)) INDEX ON Date TAG Date ELSE * ОТКРОЕМ ТАБЛИЦУ USE (lcPath + 'Currency') ORDER Date IN 0 ENDIF ENDIF * ЦИКЛ ПО ДАТАМ В ПЕРИОДЕ FOR lnDay = 0 TO ldEnd - ldBeg * ТЕКУЩАЯ ДАТА ldCur = ldBeg + lnDay lcAddress = 'http://www.cbr.ru/scripts/XML_daily.asp?date_req=' +; TRANSFORM(DAY(ldCur), '@L 99') + '/' +; TRANSFORM(MONTH(ldCur), '@L 99') + '/' +; TRANSFORM(YEAR(ldCur), '@L 9999') lcXMLFile = ADDBS(SYS(2023)) + SYS(2015) + '.TMP' * ЗАГРУЗИМ ФАЙЛ И СОХРАНИМ ЕГО ЛОКАЛЬНО IF IsFileDownloaded(lcAddress, lcXMLFile) SET KEY TO ldCur IF XMLTOCURSOR(lcXMLFile, 'Temp', 512) > 0 IF VARTYPE(Value) = 'C' AND VARTYPE(NumCode) = 'N' AND VARTYPE(Nominal) = 'N' * ЦИКЛ ПО ВАЛЮТАМ НА ДАТУ * MESSAGEBOX('Загрузка курсов валют за ' + DTOS(ldCur), 64, APP_NAME, 1) SCAN lnSum = EVAL(CHRTRAN(CHRTRAN(Value, ',', '.'), CHR(160), '')) SELECT Currency LOCATE FOR Code = Temp.NumCode IF FOUND() REPLACE Code WITH Temp.NumCode, Quant WITH Temp.Nominal, Sum WITH lnSum ELSE INSERT INTO Currency (Date, Code, Quant, Sum) VALUES; (ldCur, Temp.NumCode, Temp.Nominal, lnSum) ENDIF lnSuccess = lnSuccess + 1 ENDSCAN ELSE MESSAGEBOX('Неверная структура XML курсора с курсами за ' + DTOS(ldCur) +; CHR_CR2 + FILETOSTR(lcXMLFile), 64, APP_NAME) ENDIF ENDIF USE SELECT Currency SET KEY TO ERASE (lcXMLFile) ELSE MESSAGEBOX('Не удалось получить XML файл с курсами валют за ' + DTOS(ldCur), 64, APP_NAME) ENDIF ENDFOR * СОХРАНИМ КУРСОР В FPD DBF IF !FILE(lcPath + 'Currency.dbf') COPY TO (lcPath + 'Currency') TYPE FOX2X AS 866 USE Currency EXCLUSIVE INDEX ON Code TAG Code INDEX ON Date TAG Date DESCENDING ENDIF ENDCASE CATCH TO loException * ВЫДАДИМ СООБЩЕНИЕ ОБ ОШИБКЕ DO ShowError WITH loException ENDTRY RETURN lnSuccess * ПОДКЛЮЧЕН ЛИ КОМПЬЮТЕР К ИНТЕРНЕТУ ? FUNCTION IsInternetConnected LOCAL lnFlags AS Integer DECLARE SHORT InternetGetConnectedState IN WININET LONG @, LONG lnFlags = 0 InternetGetConnectedState(@lnFlags, 0) CLEAR DLLS 'InternetGetConnectedState' RETURN !INLIST(lnFlags, 0, 16, 32, 48) * УСПЕШНО ЛИ ЗАГРУЖЕН ФАЙЛ ? FUNCTION IsFileDownloaded LPARAMETERS tcSourceFile AS String, tcTargetFile AS String IF !FILE(tcTargetFile) DECLARE INTEGER URLDownloadToFile IN URLMON.DLL LONG, STRING, STRING, LONG, LONG URLDownloadToFile(0, tcSourceFile, tcTargetFile, 0, 0) CLEAR DLLS 'URLDownloadToFile' RETURN FILE(tcTargetFile) ENDIF RETURN .F. * СООБЩЕНИЕ ОБ ОШИБКЕ PROCEDURE ShowError LPARAMETERS toException AS Exception LOCAL lcErrorNo AS String, lcMessage AS String, lcStackLevel AS String,; lcProcedure AS String, lcLineNo AS String, lcLineContents AS String TRY lcErrorNo = 'Номер ошибки' + CHR_TAB + ': ' + TRANSFORM(toException.ErrorNo) + CHR_CR lcMessage = 'Сообщение' + CHR_TAB + ': ' + toException.Message + CHR_CR lcStackLevel = 'Уровень стека' + CHR_TAB + ': ' + TRANSFORM(toException.StackLevel) + CHR_CR lcProcedure = 'Процедура' + CHR_TAB + ': ' + toException.Procedure + CHR_CR lcLineNo = 'Номер строки' + CHR_TAB + ': ' + TRANSFORM(toException.LineNo) lcLineContents = IIF(Application.Startmode = 0,; CHR_CR + 'Содержимое' + CHR_TAB + ': ' + toException.LineContents, '') MESSAGEBOX(lcErrorNo + lcMessage + lcStackLevel + lcProcedure + lcLineNo + lcLineContents, 16, APP_NAME) CATCH MESSAGEBOX('Ошибка при попытке вывести сообщение об ошибке', 16, APP_NAME) ENDTRY RETURN * КУРС USD ЗА ПЕРИОД * http://www.cbr.ru/scripts/XML_dynamic.asp?date_req1=01/11/2009&date_req2=30/11/2009&VAL_NM_RQ=R01235 [/code]
Автор: urfin

Автор публикации

не в сети 17 лет

urfin

0
Комментарии: 0Публикации: 3Регистрация: 17-08-2004
0
Оставить комментарий
Авторизация
*
*
Генерация пароля