Code: |
#include "s_public.ch" #include "set.ch" #include "s_refer.ch" #include "inkey.ch" #include "my.ch" Function OldCurs() Local aSet := SaveSet() Local nTop := 4,nBottom:=21 Local cBoxHead := 'БЭСТ: Курсы валют [Интернет версия] 1.01' Local cHead:=' Справочник курсов валют ' Local cColHead:={'Валюта Дата Курс ' } Local aHeads:={{'Код валюты.................: ','Valuta'},; {'Дата установки ............: ','Date'},; {'Курс к основной валюте.... : ','VCurs'} } Local aBlockCols := { { {|| Valuta}, 1 },; { {|| Date }, 8 },; { {|| vCurs }, 18 } ; } Local aWhen := {{|| nApp != 1 },{|| nApp != 1 }} Local aValid := {,,{|| !Empty(aIn[3]) }} Local aPict := {,,'9999999.9999'} Local aRef := {'RefVal'} Local nUniMode := 2 Local bDelInit := {|| IsDel()} Local bScrInit Local aSortSeek:={; {'По валютам и датам',{'Введите код валюты.:',; ' и дату.....:'},{'Valuta','DATE'},; "UPPER(aIn[1])+DTOS(aIn[2])",{'XXX','@D 99/99/99'},,,'VALUTA' },; {'По датам и валютам', {'Введите дату.......:',; ' и код валюты.:'},{'DATE','Valuta'},; "DTOS(aIn[1])+UPPER(aIn[2])",{'@D 99/99/99',"XXX"},,,'DATE' } ; } Local aPrintHeads:={'Справочник курсов валют','Код','Дата','Курс'} Local cCurProc Local bPost ,bDelPost ,aGetBlock ,bColor ,bColor1 ,; nLeftBrd ,bScrPost ,cFindMacro,cCol_Browse,lYesClear ,; bPreGet ,bPostGet ,nTag ,nDispRow ,aHotKey ,; bRestSave,bPostRead,lSubIndex ,bSayHead ,bKeyHead bPreGet := {|| if( nApp==2 ,(aIn[2] := Date(),aIn[3] := 0.0000),) } ScrMain() ScrTitul(1,cBoxHead) ScrTitul(24,; "┘:Изм F2:Узнать F3:Сорт F4:Ввод F5:Обновить F6:Фильтр F7:Пск F8:Удалить") ShadowBox(cHead,3,20,22,60,COL_BROWSE) if m_Open_Base( {'Valuta','vCurs','Plan0','Main'} ) UT_SetFilter('Upper(Code) != GlobalValuta','Valuta') MakeRefer("RefVal","Валюта",1,{"Код","Наименование"},{4,43,12},COL_REFER, {"Code"},{"aIn[1]"},"aIn[1]") SetKey(K_F5 ,{|| IRefresh() }) SetKey(K_F2 ,{|| IKnown() }) Select vCurs InitList(nTop,nBottom,cColHead,aBlockCols,cCurProc,aHeads,aRef,; aPict,aWhen,aValid,nUniMode,bDelInit,bScrInit,aSortSeek,aPrintHeads,; bPost ,bDelPost ,aGetBlock ,bColor ,bColor1 ,; nLeftBrd ,bScrPost ,cFindMacro,cCol_Browse,lYesClear ,; bPreGet ,bPostGet ,nTag ,nDispRow ,aHotKey ,; bRestSave,bPostRead,lSubIndex ,bSayHead ,bKeyHead ) ClearRefer() m_Close_Base( {'Valuta','vCurs','Plan0','Main'} ) endif RestSet(aSet) Return NIL static Function IsDel() Local OldSel := Select() Local lResult Begin Sequence lResult := .f. Main->(__dbLocate( {|| Upper( Main->Valuta ) == Upper(vCurs->Valuta).and.Main->DataOper == vCurs->Date},,,, .F. )) if Found() SayError( "Значение курса использовано в проводках" ) Break endif Plan0->(__dbLocate( {|| Upper( Plan0->Valuta ) == Upper(vCurs->Valuta).and.Plan0->Date - 1 == vCurs->Date},,,, .F. )) if Found() SayError( "Значение курса использовано в вступительном балансе" ) Break endif lResult := .t. End Sequence Select( OldSel) Return (lResult) Static Function IRefresh() Local aSet:={SaveSet(),SaveSetKey()} Local GetList := {},oGet Local OldDateFormat:=Set(_SET_DATEFORMAT,"dd.mm.yyyy") Local nTop := 10,nLeft := 10,nBottom:=16,nRight:=71 Local nOff := 29 Local xmlDoc,nodeList,xmlNode,node_attr Local url_request Local iIndex,iEnd,i,n Local bDate,eDate Local cDate,dDate,cCurs,nCurs,cCode,cName,xDate Local aPrev := NIL Private aDop:={; {.T.," Да "},; {.F.," Нет "} ; } Private aIn:=Array(5) Private aCBR := {; // 12345678901234567890 {'R01235',"Доллар США "}; } aIn[1] := vCurs->Valuta aIn[2] := 'R01235' aIn[3] := Bom(Date()) aIn[4] := Date() aIn[5] := .f. Begin Sequence TRY xmlDoc := CreateObject( "MSXML2.DomDocument" ) CATCH TRY xmlDoc := CreateObject( "MSXML2.DomDocument.4.0" ) CATCH SayError( "MsXml2 не доступен!") Break END END xmlDoc:async := .f. url_request := "http://www.cbr.ru/scripts/XML_val.asp?d=0" Busy(.T.,"Запрос справочника валют") if !xmldoc:Load(url_request) SayError("Cправочник валют не загружен !") Busy(.F.) Break end Busy(.F.) NodeList := xmldoc:selectNodes("*/Item") iEnd := NodeList:length - 1 if iEnd < 0 SayError( "Справочник валют не загружен !") Break endif aCBR := {} For iIndex := 0 To iEnd xmlNode := NodeList:Item(iIndex):cloneNode(.t.) cCode := xmlNode:Attributes(0):Value // Код валюты cName := AnsiToOem(xmlNode:childNodes(0):Text) // Наименование cName := Left(cName,30) cName := Padr(cName,30) aadd(aCBR,{cCode,cName}) next ShadowBox("",nTop,nLeft,nBottom,nRight,COL_INPUT,) // 12345678901234567890123456789 @ nTop+1,nLeft +1 Say "Валюта БЭСТ :" Color 'w/bg' @ nTop+2,nLeft +1 Say "Валюта ЦБР :" Color 'w/bg' @ nTop+3,nLeft +1 Say "Начальная дата дд.мм.гггг :" Color 'w/bg' @ nTop+4,nLeft +1 Say "Конечная дата дд.мм.гггг :" Color 'w/bg' @ nTop+5,nLeft +1 Say "Дополнять вых. и пр. дни :" Color 'w/bg' @ nTop+1,nLeft+nOff REFER 'RefVal' GET aIn[1] PICTURE "XXX" Color COL_GET oGet:=GETNEW(nTop+2,nLeft+nOff,{|x|IF(x=NIL,aIn[2],aIn[2] := aCBR[1])}) oGet:block:={|x|RotateBlock(x,aCBR,'aIn[2]')} oGet:reader := {|x|RotateAndReader(x,aCBR) } oGet:ColorSpec := COL_GET AADD(GetList, oGet) @ nTop+3,nLeft+nOff GET aIn[3] PICTURE "@D" Color COL_GET VALID aIn[3] <= aIn[4] @ nTop+4,nLeft+nOff GET aIn[4] PICTURE "@D" Color COL_GET VALID aIn[4] >= aIn[3] oGet:=GETNEW(nTop+5,nLeft+nOff,{|x|IF(x=NIL,aIn[5],aIn[5] := aDop[1])}) oGet:block:={|x|RotateBlock(x,aDop,'aIn[5]')} oGet:reader := {|x|RotateAndReader(x,aDop) } oGet:ColorSpec := COL_GET AADD(GetList, oGet) AEVAL( GetList, {|x| x:Display() } ) SetCursor(1) READ SetCursor(0) if LastKey() != K_ESC.and. YesOrNo({"Запросить курсы валюты "+aIn[1]+ " ?",; "Период запроса с "+Dtoc(aIn[3])+" по "+Dtoc(aIn[4])},,,,,,COL_BROWSE) bDate := DTOC(aIn[3]) eDate := DTOC(aIn[4]) url_request := "http://www.cbr.ru/scripts/XML_dynamic.asp?date_req1="+bDate+"&date_req2="+eDate+"&VAL_NM_RQ="+aIn[2] Busy(.T.,"Выполнение запроса") if !xmldoc:Load(url_request) SayError("Курсы валют не загружены !") Busy(.F.) Break end Busy(.F.) NodeList := xmldoc:selectNodes("*/Record") iEnd := NodeList:length - 1 if iEnd < 0 SayError( "Курсы валют не загружены !") Break endif Busy(.T.,"Обработка результата запроса") For iIndex := 0 To iEnd xmlNode := NodeList:Item(iIndex):cloneNode(.t.) cDate := xmlNode:Attributes(0):Value // Дата cCode := xmlNode:Attributes(1):Value // Код валюты cCurs := xmlNode:childNodes(1):Text // Курс cCurs := StrTran( cCurs, ',','.') nCurs := Val(cCurs) dDate := CTOD(cDate) altd() if aIn[5].and.aPrev != NIL if dDate != aPrev[1] + 1 xDate := aPrev[1] + 1 while xDate != dDate if vCurs->(dbSeek( Upper(aIn[1])+DTOS(xDate) )) if vCurs->(RecLock()) vCurs->vCurs := aPrev[2] vCurs->(dbUnLock()) endif else if vCurs->(AddRec()) vCurs->Valuta := aIn[1] vCurs->Date := xDate vCurs->vCurs := aPrev[2] vCurs->(dbUnLock()) endif endif xDate++ enddo endif endif aPrev := {dDate,nCurs} if vCurs->(dbSeek( Upper(aIn[1])+DTOS(dDate) )) if vCurs->(RecLock()) vCurs->vCurs := nCurs vCurs->(dbUnLock()) endif else if vCurs->(AddRec()) vCurs->Valuta := aIn[1] vCurs->Date := dDate vCurs->vCurs := nCurs vCurs->(dbUnLock()) endif endif next vCurs->(dbSeek( Upper(aIn[1])+DTOS(aIn[3]) )) // vCurs->(dbGoTop()) Busy(.F.) SayAndWait("Курсы валюты "+aIn[1]+ " обновлены успешно.") endif End Sequence Set(_SET_DATEFORMAT,OldDateFormat) RestSet(aSet[1]) RestSetKey(aSet[2]) Return NIL static Function UT_SetFilter(cFilter,cAlias,cFocus) cAlias := if(cAlias == NIL,,cAlias) cFocus := if(cFocus == NIL,,cFocus ) cFilter := if(cFilter == NIL,,cFilter ) if Empty(cFilter) Return .f. end if !Empty(cAlias) dbSelectArea(cAlias) end if !Empty(cFocus) OrdSetFocus(cFocus) end dbSetFilter({|| &cFilter}, cFilter) dbGoTop() Return .t. Static Function IKnown() Local aSet:={SaveSet(),SaveSetKey()} Local GetList := {},oGet Local OldDateFormat:=Set(_SET_DATEFORMAT,"dd.mm.yyyy") Local nTop := 10,nLeft := 10,nBottom:=13,nRight:=71 Local nOff := 29 Local xmlDoc,nodeList,xmlNode,node_attr Local url_request Local iIndex,iEnd,i,n Local bDate,eDate Local cDate,dDate,cCurs,nCurs,cCode,cName,xDate Local aPrev := NIL Private aIn:=Array(2) Private aCBR := {; // 12345678901234567890 {'R01235',"Доллар США "}; } aIn[1] := 'R01235' aIn[2] := Date() Begin Sequence TRY xmlDoc := CreateObject( "MSXML2.DomDocument" ) CATCH TRY xmlDoc := CreateObject( "MSXML2.DomDocument.4.0" ) CATCH SayError( "MsXml2 не доступен!") Break END END xmlDoc:async := .f. url_request := "http://www.cbr.ru/scripts/XML_val.asp?d=0" Busy(.T.,"Запрос справочника валют") if !xmldoc:Load(url_request) SayError("Cправочник валют не загружен !") Busy(.F.) Break end Busy(.F.) NodeList := xmldoc:selectNodes("*/Item") iEnd := NodeList:length - 1 if iEnd < 0 SayError( "Справочник валют не загружен !") Break endif aCBR := {} For iIndex := 0 To iEnd xmlNode := NodeList:Item(iIndex):cloneNode(.t.) cCode := xmlNode:Attributes(0):Value // Код валюты cName := AnsiToOem(xmlNode:childNodes(0):Text) // Наименование cName := Left(cName,30) cName := Padr(cName,30) aadd(aCBR,{cCode,cName}) next ShadowBox("",nTop,nLeft,nBottom,nRight,COL_INPUT,) // 12345678901234567890123456789 @ nTop+1,nLeft +1 Say "Валюта ЦБР :" Color 'w/bg' @ nTop+2,nLeft +1 Say "Дата запроса дд.мм.гггг :" Color 'w/bg' oGet:=GETNEW(nTop+1,nLeft+nOff,{|x|IF(x=NIL,aIn[1],aIn[1] := aCBR[1])}) oGet:block:={|x|RotateBlock(x,aCBR,'aIn[1]')} oGet:reader := {|x|RotateAndReader(x,aCBR) } oGet:ColorSpec := COL_GET AADD(GetList, oGet) @ nTop+2,nLeft+nOff GET aIn[2] PICTURE "@D" Color COL_GET AEVAL( GetList, {|x| x:Display() } ) SetCursor(1) READ SetCursor(0) if LastKey() != K_ESC.and. YesOrNo({"Запросить курс валюты ?",; "Запрос на "+Dtoc(aIn[2])},,,,,,COL_BROWSE) bDate := DTOC(aIn[2]) eDate := DTOC(aIn[2]) url_request := "http://www.cbr.ru/scripts/XML_dynamic.asp?date_req1="+bDate+"&date_req2="+eDate+"&VAL_NM_RQ="+AllTrim(aIn[1]) Busy(.T.,"Выполнение запроса") if !xmldoc:Load(url_request) SayError("Курс валюты не загружены !") Busy(.F.) Break end Busy(.F.) NodeList := xmldoc:selectNodes("*/Record") iEnd := NodeList:length - 1 if iEnd < 0 SayError( "Курс валюты не найден !") Break endif Busy(.T.,"Обработка результата запроса") For iIndex := 0 To iEnd xmlNode := NodeList:Item(iIndex):cloneNode(.t.) cDate := xmlNode:Attributes(0):Value // Дата cCode := xmlNode:Attributes(1):Value // Код валюты cCurs := xmlNode:childNodes(1):Text // Курс cCurs := StrTran( cCurs, ',','.') nCurs := Val(cCurs) dDate := CTOD(cDate) Next Busy(.F.) SayAndWait({"Курс валюты на "+Dtoc(aIn[2]) +" = "+ cCurs }) endif End Sequence Set(_SET_DATEFORMAT,OldDateFormat) RestSet(aSet[1]) RestSetKey(aSet[2]) Return NIL |
output generated using printer-friendly topic mod. All times are GMT + 4 Hours