Главная
Новый форум
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Курсы валют чз Интернет в Б4+

 
Post new topic   Reply to topic   printer-friendly view     Forum Index -> Программирование в БЭСТ-4
View previous topic :: View next topic  
Author Message
Хьюстон



Joined: 19 Oct 2007
Posts: 1
Location: Хардырбиев
Occupation: Урсам
Interests: Урсамович
PostPosted: 19 Oct 2007 20:32    Post subject: Курсы валют чз Интернет в Б4+ Reply with quote
// Всем нуждающимся посвящается !
// замечания принимаются по адресу 43valery@mail.ru
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
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic   printer-friendly view     Forum Index -> Программирование в БЭСТ-4 All times are GMT + 4 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © phpBB Group

Rambler
Rambler's Top100 Рейтинг@Mail.ru