On-line: Andrey, гостей 0. Всего: 1 [подробнее..]
АвторСообщение
администратор




Пост N: 1511
Зарегистрирован: 20.02.11
ссылка на сообщение  Отправлено: 06.02.20 17:17. Заголовок: Курсы ЦБ РФ на дату


потребовалось часто и быстро дергать курсы валют с ЦБ РФ , за пару часов написал функцию. Может кому сгодиться
на оригинальность не претендую , но работает . Возвращает массив значений на дату .
 
FUNC GetCBR( dDate)
LOCAL oHttp, cHtml, oNode, oDoc, oVal, oIterator, oCurrent
LOCAL aArray := {}
LOCAL cNumCode, cCharCode ,cNominal, cName, cValue
LOCAL aCur := {}
LOCAL cDate := StrZero(Day( dDate ),2,0) + "/" + StrZero(month( dDate ),2,0) + "/" + StrZero(year( dDate ),4,0)

oHttp := TIpClientHttp():new( "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + cDate )
IF ! oHttp:open()
MsgBox( "Connection error:", oHttp:lastErrorMessage() )
RETURN {}
ENDIF

cHtml := oHttp:readAll()
oHttp:close()
oDoc := TXMLDocument():New( cHtml, 8 ) // см. hbxml.ch
IF oDoc:nError != 0
MsgBox( "xml file parsing error " + hb_ntos( oDoc:nError ) )
RETURN {}
ENDIF

oVal := oDoc:findfirst( "Valute" )
IF oVal == NIL
MsgBox( "no Valute found" )
RETURN {}
ENDIF

DO WHILE .T.

oIterator := TXMLIterator():New( oVal )

DO WHILE .T.
oCurrent := oIterator:Next()
IF oCurrent == NIL
EXIT
ELSE

switch oCurrent:cName
case "CharCode"
cCharCode := oCurrent:cData
exit
case "NumCode"
cNumCode := oCurrent:cData
exit
case "Nominal"
cNominal := oCurrent:cData
exit
case "Name"
cName := oCurrent:cData
exit
case "Value"
cValue := CharRepl(",", oCurrent:cData, ".")
exit
end switch

ENDIF

ENDDO
AAdd(aCur, {cCharCode, cNumCode, Val(cNominal), cName, Val(cValue)} )
oVal := oDoc:findnext()
IF oVal == NIL
EXIT
ENDIF
ENDDO
RETURN aCur


Спасибо: 1 
ПрофильЦитата Ответить
Новых ответов нет , стр: 1 2 3 All [см. все]


администратор




Пост N: 7162
Зарегистрирован: 17.05.05
ссылка на сообщение  Отправлено: 06.02.20 22:02. Заголовок: Haz :sm36:..


Haz


Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 6575
Зарегистрирован: 12.09.06
ссылка на сообщение  Отправлено: 07.02.20 07:31. Заголовок: Сделай этот пример д..


Сделай этот пример для МиниГуи !
Будет классно для всех.

Спасибо: 0 
ПрофильЦитата Ответить
администратор




Пост N: 1512
Зарегистрирован: 20.02.11
ссылка на сообщение  Отправлено: 07.02.20 08:14. Заголовок: Andrey пишет: Сдела..


Andrey пишет:

 цитата:
Сделай этот пример для МиниГуи !

Сделаю сегодня

Спасибо: 0 
ПрофильЦитата Ответить





Пост N: 217
Зарегистрирован: 05.11.05
ссылка на сообщение  Отправлено: 07.02.20 11:54. Заголовок: Я в свое время делал..


Я в свое время делал нечто подобное, поэтому могу оценить. Красиво!

Спасибо: 0 
ПрофильЦитата Ответить
администратор




Пост N: 1513
Зарегистрирован: 20.02.11
ссылка на сообщение  Отправлено: 07.02.20 13:08. Заголовок: rvu пишет: Сделай э..


Андрей:

 цитата:
Сделай этот пример для МиниГуи !


где то так

 
#include "minigui.ch"
#include "TSBrowse.ch"

REQUEST DBFCDX

Func Main()
LOCAL aStr := {}
LOCAL cDbf := "Rates"
LOCAL n := 0
LOCAL oWnd

SET OOP ON
SET DATE FORMAT 'DD.MM.YYYY'
rddSetDefault( 'DBFCDX' )

IF !hb_FileExists( cDbf + ".dbf" )
AAdd( aStr, { 'DATE', 'D', 8, 0 } )
AAdd( aStr, { 'CHARCODE', 'C', 3, 0 } )
AAdd( aStr, { 'NUMCODE', 'C', 3, 2 } )
AAdd( aStr, { 'NAME', 'C', 50, 0 } )
AAdd( aStr, { 'NOMINAL', 'N', 5, 0 } )
AAdd( aStr, { 'VALUE', 'N', 12, 4 } )

dbCreate( cDbf + ".dbf", aStr )

ENDIF

USE ( cDbf + ".dbf" ) ALIAS "RATES" EXCL NEW

IF hb_FileExists( cDbf + ".cdx" )
SET INDEX TO ( cDbf + ".cdx")
ELSE
INDEX ON DATE TAG "DATE" TO ( cDbf + ".cdx")
END

RATES->(OrdSetFocus("DATE"))

DEFINE WINDOW Form_0 ;
At 0, 0 ;
WIDTH 510 ;
HEIGHT 700 ;
TITLE "Exchange rate of the Central Bank of the Russian Federation" ;
MAIN ;
NOMAXIMIZE NOSIZE ;
ON RELEASE dbCloseArea( "RATES" )

oWnd := ThisWindow.Object

DEFINE STATUSBAR
STATUSITEM "" WIDTH 230 FONTCOLOR BLUE
END STATUSBAR

END WINDOW


DEFINE LABEL Label_1
PARENT Form_0
ROW 7
COL 5
WIDTH 300
HEIGHT 16
FONTNAME 'Arial Narrow'
FONTSIZE 9
FONTBOLD TRUE
FONTITALIC TRUE
FONTCOLOR {0,0,0}
VALUE "Exchange rate of the Central Bank of the Russian Federation on:"
END LABEL

DEFINE DATEPICKER Date_1
PARENT Form_0
ROW 2
COL oWnd:ClientWidth - 105
WIDTH 100
VALUE Date()
SHOWNONE .F.
FONTNAME 'Arial'
FONTSIZE 9
FONTBOLD FALSE
FONTITALIC FALSE
ON CHANGE { || SetDate( This.Value ) }
TABSTOP .F.
END DATEPICKER



DEFINE TBROWSE oBrw ;
AT 30, 1 ;
ALIAS "RATES" ;
OF Form_0 ;
WIDTH oWnd:ClientWidth - 2 ;
HEIGHT oWnd:ClientHeight - 30 - oWnd:StatusBar:Height;
GRID ;
COLORS { CLR_BLACK, CLR_BLUE } ;
FONT "MS Sans Serif" ;
SIZE 9

:aColSel := {"CHARCODE", "NUMCODE", "NAME", "NOMINAL", "VALUE"}

:LoadFields( TRUE )
:lCellBrw := TRUE
:nHeightCell := 20
:nWheelLines := 1
:nHeightHead := 25
:SetColor( { 11 }, { { || Rgb( 255, 255, 255 ) } } )
:nClrLine := RGB(180,180,180)//COLOR_GRID
:lNoPopUp := TRUE

:hBrush := CreateSolidBrush(255,255,240)

AEval( oBrw:aColumns, {| oCol| oCol:lFixLite := TRUE } )


:SetColor( { 2 }, { { || RGB(255,255,240) } } )
:SetColor( { 5 }, { { || RGB(0,0,0) } } )
:SetColor( { 6 }, { { |a,b,c| IF( c:nCell == b, -CLR_HRED , -RGB(128,225,225) ) } } )
:SetColor( { 12 }, { { |a,b,c| IF( c:nCell == b, -RGB(128,225,225) , -RGB(128,225,225) ) } } )
:SetColor( { 11 }, { { || RGB(0,0,0) } } )

:SetAppendMode( FALSE )
:SetDeleteMode( FALSE )

:SetColSize( "CharCode", 40)
:GetColumn( "CharCode" ):cHeading := "Char" + CRLF + "Code"
:GetColumn( "CharCode"):lEdit := FALSE
:GetColumn( "CharCode"):nAlign := DT_CENTER
:GetColumn( "CharCode"):cPicture := "@R XXX "

:SetColSize( "NumCode", 40)
:GetColumn( "NumCode" ):cHeading := "Num" + CRLF + "Code"
:GetColumn( "NumCode"):lEdit := FALSE
:GetColumn( "NumCode"):nAlign := DT_CENTER
:GetColumn( "NumCode"):cPicture := "@R XXX "

:SetColSize( "Name", 300)
:GetColumn( "Name" ):cHeading := "Name"
:GetColumn( "Name"):lEdit := FALSE
:GetColumn( "Name"):nAlign := DT_LEFT
:GetColumn( "Name"):cPicture := "@R " + Replicate("X", 50) + " "

:SetColSize( "Nominal", 50)
:GetColumn( "Nominal" ):cHeading := "Nominal"
:GetColumn( "Nominal"):lEdit := FALSE
:GetColumn( "Nominal"):nAlign := DT_CENTER
:GetColumn( "Nominal"):cPicture := "@R 99999 "

:SetColSize( "Value", 50)
:GetColumn( "Value" ):cHeading := "Value"
:GetColumn( "Value"):lEdit := FALSE
:GetColumn( "Value"):nAlign := DT_CENTER
:GetColumn( "Value"):cPicture := "@R 999.9999 "


END TBROWSE


SetDate( Date() )


Form_0.Center
Form_0.Activate

RETURN NIL

FUNC SetDate( dDate )
LOCAL aArray := {}

Rates->(OrdScope(0, NIL ))
Rates->(OrdScope(1, NIL ))


IF !Rates->(dbSeek(dDate))
aArray := GetCBR( dDate )
IF !Empty(aArray)
AEval( aArray, {|e| Rates->(DBAppend()),;
Rates->Date := dDate,;
Rates->CHARCODE := e[1],;
Rates->NUMCODE := e[2],;
Rates->NOMINAL := e[3],;
Rates->NAME := e[4],;
Rates->VALUE := e[5] ;
} )
END
END
Rates->(OrdScope(0, dDate ))
Rates->(OrdScope(1, dDate ))
Rates->(dbGoTop())
oBrw:Reset()

RETURN nil

FUNC GetCBR( dDate)
LOCAL oHttp, cHtml, oNode, oDoc, oVal, oIterator, oCurrent
LOCAL cNumCode, cCharCode ,cNominal, cName, cValue
LOCAL aArray := {}
LOCAL cDate := StrZero(Day( dDate ),2,0) + "/" + StrZero(month( dDate ),2,0) + "/" + StrZero(year( dDate ),4,0)


oHttp := TIpClientHttp():new( "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + cDate )
IF ! oHttp:open()
Form_0.StatusBar.Item(2) := "Connection error: " + oHttp:lastErrorMessage()
RETURN {}
ENDIF

Form_0.StatusBar.Item(2) := "Connection established"

cHtml := oHttp:readAll()
oHttp:close()
oDoc := TXMLDocument():New( cHtml, 8 ) // см. hbxml.ch
IF oDoc:nError != 0
Form_0.StatusBar.Item(1) := "xml parsing error " + hb_ntos( oDoc:nError )
RETURN {}
ENDIF

oVal := oDoc:findfirst( "Valute" )
IF oVal == NIL
Form_0.StatusBar.Item(1) := "xml parsing error " + "Key not found"
RETURN {}
ENDIF

DO WHILE .T.

oIterator := TXMLIterator():New( oVal )

DO WHILE .T.
oCurrent := oIterator:Next()
IF oCurrent == NIL
EXIT
ELSE

switch oCurrent:cName
case "CharCode"
cCharCode := oCurrent:cData
exit
case "NumCode"
cNumCode := oCurrent:cData
exit
case "Nominal"
cNominal := oCurrent:cData
exit
case "Name"
cName := oCurrent:cData
exit
case "Value"
cValue := CharRepl(",", oCurrent:cData, ".")
exit
end switch

ENDIF

ENDDO
AAdd(aArray, {cCharCode, cNumCode, Val(cNominal), cName, Val(cValue)} )
oVal := oDoc:findnext()
IF oVal == NIL
EXIT
ENDIF
ENDDO

IF !Empty(aArray)
Form_0.StatusBar.Item(1) := "Data successfully received"
END
RETURN aArray


Спасибо: 0 
ПрофильЦитата Ответить





Пост N: 218
Зарегистрирован: 05.11.05
ссылка на сообщение  Отправлено: 07.02.20 13:43. Заголовок: Надо, чтобы включили..


Надо, чтобы включили в примеры.

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 3029
Зарегистрирован: 17.02.12
ссылка на сообщение  Отправлено: 07.02.20 17:29. Заголовок: Игорь, пример оч. хо..


Игорь, пример оч. хороший !
СПАСИБО !
Перенес в свою версию на ура.
Вот что получилось, в тек. версии hmg должно работать тоже, кроме ";" в HEADERS.
Текст совсем короткий Скрытый текст


Спасибо: 0 
ПрофильЦитата Ответить
администратор




Пост N: 1514
Зарегистрирован: 20.02.11
ссылка на сообщение  Отправлено: 07.02.20 18:11. Заголовок: SergKis пишет: Вот ..


SergKis пишет:

 цитата:
Вот что получилось


Отлично оптимизировал
Добавь к
 
:GetColumn("Name"):nAlign := DT_LEFT
:GetColumn("Name"):nWidth := 300
:GetColumn("Name"):cPicture := "@R " + Replicate("X", 50) именно @R c пробелом(иногда и по два и более делаю) , будет отступ от вертикальной линии

ЗЫ я такими шаблонами вложенность строк в структурах показываю




Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 3030
Зарегистрирован: 17.02.12
ссылка на сообщение  Отправлено: 07.02.20 19:46. Заголовок: Haz пишет я такими ш..


Haz пишет
 цитата:
я такими шаблонами вложенность строк в структурах показываю


И как ты это делаешь ? меняешь oCol:cPicture налету ?
Я в :bDecode от кода строки (или еще от чего) добавляю определенное кол-во space(nN) для сдвига

Спасибо: 0 
ПрофильЦитата Ответить
администратор




Пост N: 1515
Зарегистрирован: 20.02.11
ссылка на сообщение  Отправлено: 07.02.20 20:09. Заголовок: SergKis пишет: И ка..


SergKis пишет:

 цитата:
И как ты это делаешь ? меняешь oCol:cPicture налету ?


Да, для показа шаблон со сдвигом, в :prevedit меняю на обычный, в :editexit восстанавливаю сдвиг. Сам сдвиг храниться в спец поле indent, количество пробелов в шаблоне равно indent*2
Сначала тоже дополнял само значение слева пробелами, но потом понял что менять значение не удобно тк в редактирование значение шло с телефона пробелами, а пользователь мог удалить, а мог и нет., и не понять что он ввел

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 3031
Зарегистрирован: 17.02.12
ссылка на сообщение  Отправлено: 07.02.20 20:38. Заголовок: Haz пишет Да, для по..


Haz пишет
 цитата:
Да, для показа шаблон со сдвигом, в :prevedit меняю на обычный, в :editexit восстанавливаю сдвиг. Сам сдвиг храниться в спец поле indent, количество пробелов в шаблоне равно indent*2


OK! Надо тоже переходить на такую схему

Спасибо: 0 
ПрофильЦитата Ответить
администратор




Пост N: 1516
Зарегистрирован: 20.02.11
ссылка на сообщение  Отправлено: 07.02.20 21:12. Заголовок: SergKis пишет: шло ..


SergKis пишет:

 цитата:
шло с телефона пробелами, а


Откуда тут с "телефона" не набирал точно, хотя набирал с телефона

Спасибо: 0 
ПрофильЦитата Ответить
Администратор




Пост N: 3917
Зарегистрирован: 23.05.05
ссылка на сообщение  Отправлено: 08.02.20 16:35. Заголовок: Мне время от времени..


Мне время от времени приходится выбирать информацию из формата xml, делаю это с помощью класса Александра Кресина. Он есть и в поставке hmg
Разбор курсов валют ЦБР выглядел бы так:

Function ScanCBR(cHtml) 
Local oXml, oCurs
Local aCur := {}

if (oXml := HXmlDoc():ReadString(cHtml)) # nil .and. (oCurs := oXml:Find("ValCurs")) # nil
AEval(oCurs:aItems, {|o| AADD(aCur, {ItmValue(o, "NumCode"), ItmValue(o, "CharCode"), ItmValue(o, "Nominal"), ItmValue(o, "Name"), ItmValue(o, "Value")})})
endif
Return aCur

Static function ItmValue(oItem, cName)
Local oIt1 := oItem:Find(cName)
Return if(oIt1#nil.and.len(oIt1:aItems)>0, oIt1:aItems[1], "")

cHtml - строка, полученная с сайта Центробанка в примере Игоря

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 3032
Зарегистрирован: 17.02.12
ссылка на сообщение  Отправлено: 08.02.20 18:41. Заголовок: Pasha пишет Мне врем..


Pasha пишет
 цитата:
Мне время от времени приходится выбирать информацию из формата xml, делаю это с помощью класса Александра Кресина. Он есть и в поставке hmg


Тоже использую этот класс и подтверждаю работает предложенный вариант
Вот, что получилось у меня (полностью перевел пример на свою lib), включат оба разбора cHtml
Скрытый текст


Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 6579
Зарегистрирован: 12.09.06
ссылка на сообщение  Отправлено: 09.02.20 01:22. Заголовок: SergKis пишет: Вот,..


SergKis пишет:

 цитата:
Вот, что получилось у меня (полностью перевел пример на свою lib), включат оба разбора cHtml


Не собирается...
Отправил проект к тебе
Собирал через MiniGUI 20.01 (Update 3)

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 3035
Зарегистрирован: 17.02.12
ссылка на сообщение  Отправлено: 09.02.20 02:11. Заголовок: Andrey SergKis пише..


Andrey
SergKis пишет:
 цитата:
полностью перевел пример на свою lib


hmg надо доводить, если надо, конечно ?
Сам пример тут https://TransFiles.ru/oymu6

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 6580
Зарегистрирован: 12.09.06
ссылка на сообщение  Отправлено: 09.02.20 14:40. Заголовок: SergKis пишет: hmg ..


SergKis пишет:

 цитата:
hmg надо доводить, если надо, конечно ?


Надо ! Обязательно !
Потом можно будет доводить этот пример для
TsbrowseSaveDbf( oBrw, "fileBrw.obrw" )
TsbrowseRestoreDbf( "fileBrw.obrw", oBrw )

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 3037
Зарегистрирован: 17.02.12
ссылка на сообщение  Отправлено: 09.02.20 14:48. Заголовок: Andrey пишет Надо ! ..


Andrey пишет
 цитата:
Надо ! Обязательно !


Тогда это самостоятельно, т.к. bcc 5.8 у меня не установлен (и не будет пока)
Позже выложу изменения

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 6581
Зарегистрирован: 12.09.06
ссылка на сообщение  Отправлено: 09.02.20 15:29. Заголовок: SergKis пишет: Тогд..


SergKis пишет:

 цитата:
Тогда это самостоятельно, т.к. bcc 5.8 у меня не установлен (и не будет пока)


Вот такие ошибки вылазят:
Harbour 3.2.0dev (r2001311434)
Copyright (c) 1999-2020, https://harbour.github.io/
Compiling 'demo.prg'...
demo.prg(119) Error E0030 Syntax error "syntax error at 'TBROWSE'"
demo.prg(120) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(121) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(122) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(123) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(124) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(125) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(126) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(127) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(129) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(130) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(131) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(132) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(133) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(134) Error E0061 Implicit send operator with no WITH OBJECT in sight
demo.prg(135) Error E0010 ENDIF does not match IF
16 errors
No code generated.

Спасибо: 0 
ПрофильЦитата Ответить
постоянный участник




Пост N: 3038
Зарегистрирован: 17.02.12
ссылка на сообщение  Отправлено: 09.02.20 16:51. Заголовок: SergKis пишет Позже ..


SergKis пишет
 цитата:
Позже выложу изменения


Выкладываю, но надо иметь ввиду, что сделаны изменения под себя.
Изменения ch файла показаны на версию Минигуи 2.07.
prg файл взял от hmg 20.01 и наложил из своей версии
Скрытый текст

Возможны ошибки, не собирал такой вариант.
Новые строки идут под отметкой // BK
Изменения и программа CBru тут https://TransFiles.ru/yk9nm

Спасибо: 0 
ПрофильЦитата Ответить
Новых ответов нет , стр: 1 2 3 All [см. все]
Ответ:
1 2 3 4 5 6 7 8 9
большой шрифт малый шрифт надстрочный подстрочный заголовок большой заголовок видео с youtube.com картинка из интернета картинка с компьютера ссылка файл с компьютера русская клавиатура транслитератор  цитата  кавычки моноширинный шрифт моноширинный шрифт горизонтальная линия отступ точка LI бегущая строка оффтопик свернутый текст

показывать это сообщение только модераторам
не делать ссылки активными
Имя, пароль:      зарегистрироваться    
Тему читают:
- участник сейчас на форуме
- участник вне форума
Все даты в формате GMT  3 час. Хитов сегодня: 126
Права: смайлы да, картинки да, шрифты да, голосования нет
аватары да, автозамена ссылок вкл, премодерация откл, правка нет