|
|
| (не показаны 6 промежуточных версий 1 участника) |
| Строка 1: |
Строка 1: |
| − | <source lang="vbnet">
| |
| − | option explicit
| |
| | | | |
| − | ' ÑиÑÑемнÑе ÑÑебованиÑ: Windows XP SP1, Windows 2000 SP3
| + | * [[Загрузка курсов валют с сайта НБРБ (XML)]] |
| − | ' Windows 2003 Server
| + | * [[Загрузка курсов валют с сайта НБРБ (HTML)]] |
| − | '
| + | |
| − | sub Curr_LoadRates
| + | |
| − | | + | |
| − | Dim Creator
| + | |
| − | Set Creator = New TCreator
| + | |
| − | | + | |
| − | ' ÑловаÑÑ CurrCode нÑжен нам Ð´Ð»Ñ Ð´Ð²ÑÑ
Ñелей:
| + | |
| − | ' во-пеÑвÑÑ
, в нем задаеÑÑÑ ÑпиÑок валÑÑ, кÑÑÑÑ
| + | |
| − | ' коÑоÑÑÑ
Ð¼Ñ Ð±Ñдем загÑÑжаÑÑ Ñ ÑайÑа
| + | |
| − | ' во-вÑоÑÑÑ
, в нем Ð¼Ñ ÑÑÑанавливаем ÑооÑвеÑÑÑвие
| + | |
| − | ' Ð¼ÐµÐ¶Ð´Ñ ÐºÐ¾Ð´Ð¾Ð¼ (бÑквенной аббÑевиаÑÑÑой) валÑÑÑ
| + | |
| − | ' иÑполÑзÑемой на ÑайÑе (Key) и кодом валÑÑÑ
| + | |
| − | ' иÑполÑзÑемÑм в наÑей базе даннÑÑ
(Item). ÐÑевидно,
| + | |
| − | ' ÑÑо они могÑÑ ÐºÐ°Ðº ÑовпадаÑÑ, Ñак и ÑазлиÑаÑÑÑÑ
| + | |
| − | ' напÑимеÑ, Ð´Ð¾Ð»Ð»Ð°Ñ Ð¡Ð¨Ð Ð½Ð° ÑайÑе Ð¼Ð¾Ð¶ÐµÑ Ð¾Ð±Ð¾Ð·Ð½Ð°ÑаÑÑÑÑ
| + | |
| − | ' как USD, а Ñ Ð½Ð°Ñ Ð² базе он бÑÐ´ÐµÑ Ð¿ÑоÑ
одиÑÑ ÐºÐ°Ðº
| + | |
| − | ' USD NBRB, ÑÑо ознаÑÐ°ÐµÑ ÐºÑÑÑ Ð´Ð¾Ð»Ð»Ð°Ñа СШÐ, ÑÑÑановленнÑй
| + | |
| − | ' ÐаÑионалÑнÑм банком РеÑпÑблики ÐелаÑÑÑÑ.
| + | |
| − | ' ÐбÑаÑиÑе внимание, ÑÑо ÐºÐ¾Ð´Ñ Ð²Ð°Ð»ÑÑ Ð¼Ð¾Ð³ÑÑ Ð¼ÐµÐ½ÑÑÑÑÑ Ð²Ð¾ вÑемени
| + | |
| − | ' напÑÐ¸Ð¼ÐµÑ Ð² одно вÑÐµÐ¼Ñ ÑÐ°Ð¹Ñ Ð¼Ð¾Ð¶ÐµÑ Ð²ÐµÑнÑÑÑ ÐºÑÑÑ Ð¿Ð¾Ð»ÑÑкого злоÑого
| + | |
| − | ' под кодом PLZ, а в дÑÑгое -- PLN
| + | |
| − | ' в Ñаком ÑлÑÑае, вÑе ÐºÐ¾Ð´Ñ Ð¾Ð´Ð½Ð¾Ð¹ и Ñой же валÑÑÑ, коÑоÑÑе
| + | |
| − | ' могÑÑ Ð¸ÑполÑзоваÑÑÑÑ Ð½Ð° ÑайÑе, Ð´Ð¾Ð»Ð¶Ð½Ñ Ð±ÑÑÑ Ð¿ÐµÑеÑиÑленÑ
| + | |
| − | ' ÑеÑез запÑÑÑÑ
| + | |
| − | Dim CurrCode
| + | |
| − | Set CurrCode = CreateObject("Scripting.Dictionary")
| + | |
| − | CurrCode.Add "USD", "USD"
| + | |
| − | CurrCode.Add "EUR", "EUR"
| + | |
| − | CurrCode.Add "RUB,RUR", "RUB"
| + | |
| − | CurrCode.Add "PLN,PLZ", "PLN"
| + | |
| − | CurrCode.Add "UAH", "UAH"
| + | |
| − | CurrCode.Add "LTL", "LTL"
| + | |
| − | CurrCode.Add "LVL", "LVL"
| + | |
| − | CurrCode.Add "GBP", "GBP"
| + | |
| − | | + | |
| − | ' иденÑиÑикаÑÐ¾Ñ Ð·Ð°Ð¿Ð¸Ñи валÑÑÑ, оÑноÑиÑелÑно коÑоÑой
| + | |
| − | ' задаÑÑÑÑ ÐºÑÑÑÑ Ð²Ð°Ð»ÑÑ Ð½Ð° ÑайÑе
| + | |
| − | ' в данном ÑлÑÑае -- ÑÑо Ð½Ð°Ñ Ñодной белоÑÑÑÑкий ÑÑблÑ
| + | |
| − | Dim BaseCurrID
| + | |
| − | BaseCurrID = gdcBaseManager.GetIDByRUIDString("200010_17")
| + | |
| − | | + | |
| − | ' даÑÑ: Ñ ÐºÐ°ÐºÐ¾Ð¹ и по какÑÑ Ð·Ð°Ð³ÑÑжаÑÑ ÐºÑÑÑÑ Ð²Ð°Ð»ÑÑ Ñ ÑайÑа
| + | |
| − | ' по какÑÑ -- возÑмем ÑекÑÑÑÑ ÑиÑÑемнÑÑ Ð´Ð°ÑÑ
| + | |
| − | ' Ñ ÐºÐ°ÐºÐ¾Ð¹ -- опÑеделим ÑледÑÑÑим обÑазом: бÑдем иÑкаÑÑ Ð² наÑей
| + | |
| − | ' базе Ð´Ð»Ñ ÐºÐ°Ð¶Ð´Ð¾Ð¹ из заданнÑÑ
валÑÑ ÑамÑÑ Ð¿Ð¾ÑледнÑÑ
| + | |
| − | ' даÑÑ ÐºÑÑÑа. из вÑеÑ
найденнÑÑ
Ð´Ð°Ñ Ð²Ð¾Ð·Ñмем наиболее ÑанÑнÑÑ.
| + | |
| − | Dim FromDate, ToDate
| + | |
| − | ToDate = Date
| + | |
| − | FromDate = ToDate
| + | |
| − | | + | |
| − | Dim q, qFind, Tr
| + | |
| − | Set Tr = Creator.GetObject(Application, "TIBTransaction", "")
| + | |
| − | Set q = Creator.GetObject(Application, "TIBSQL", "")
| + | |
| − | Set qFind = Creator.GetObject(Application, "TIBSQL", "")
| + | |
| − | | + | |
| − | Set Tr.DefaultDatabase = gdcBaseManager.Database
| + | |
| − | Set q.Transaction = Tr
| + | |
| − | Set qFind.Transaction = Tr
| + | |
| − | | + | |
| − | Tr.StartTransaction
| + | |
| − | | + | |
| − | ' ÑбеÑем ÐºÐ¾Ð´Ñ Ð²Ð°Ð»ÑÑ ÐºÐ¾ÑоÑÑÑ
Ð½ÐµÑ Ð½Ð°Ñей базе или
| + | |
| − | ' коÑоÑÑе вÑÑÑеÑаÑÑÑÑ Ð±Ð¾Ð»ÐµÐµ одного Ñаза
| + | |
| − | q.SQL.Text =_
| + | |
| − | "SELECT COUNT(c.code) " &_
| + | |
| − | "FROM gd_curr c " &_
| + | |
| − | "WHERE c.code = :C "
| + | |
| − | | + | |
| − | Dim I
| + | |
| − | For Each I in CurrCode
| + | |
| − | q.ParamByName("C").AsString = CurrCode.Item(I)
| + | |
| − | q.ExecQuery
| + | |
| − | if q.Fields(0).AsInteger <> 1 then _
| + | |
| − | CurrCode.Remove(I)
| + | |
| − | q.Close
| + | |
| − | Next
| + | |
| − | | + | |
| − | q.SQL.Text =_
| + | |
| − | "SELECT MAX(r.fordate) " &_
| + | |
| − | "FROM gd_currrate r JOIN gd_curr c ON r.fromcurr = c.id " &_
| + | |
| − | "WHERE c.code = :FC and r.tocurr = :TC"
| + | |
| − | q.ParamByName("TC").AsInteger = BaseCurrID
| + | |
| − | | + | |
| − | For Each I in CurrCode
| + | |
| − | q.ParamByName("FC").AsString = CurrCode.Item(I)
| + | |
| − | q.ExecQuery
| + | |
| − | if Int(q.Fields(0).AsDateTime) < FromDate then _
| + | |
| − | FromDate = Int(q.Fields(0).AsDateTime)
| + | |
| − | q.Close
| + | |
| − | Next
| + | |
| − | | + | |
| − | ' пÑовеÑим, Ð¼Ð¾Ð¶ÐµÑ Ð² базе Ñже еÑÑÑ Ð²Ñе кÑÑÑÑ
| + | |
| − | if ToDate < FromDate then _
| + | |
| − | exit sub
| + | |
| − | | + | |
| − | ' еÑли инÑеÑвал ÑлиÑком болÑÑой -- огÑаниÑим его
| + | |
| − | if (ToDate - FromDate) > (365 * 1) then _
| + | |
| − | FromDate = ToDate - 365 * 1
| + | |
| − | | + | |
| − | ' подгоÑовим запÑÐ¾Ñ Ð´Ð»Ñ Ð²ÑÑавки кÑÑÑа валÑÑÑ
| + | |
| − | q.SQL.Text = _
| + | |
| − | "INSERT INTO gd_currrate (fromcurr, tocurr, fordate, coeff) " &_
| + | |
| − | "SELECT ID, :TC, :FD, :R FROM gd_curr WHERE code = :FC "
| + | |
| − | q.ParamByName("TC").AsInteger = BaseCurrID
| + | |
| − | | + | |
| − | ' подгоÑовим запÑÐ¾Ñ Ð´Ð»Ñ Ð¿Ð¾Ð¸Ñка кÑÑÑа валÑÑÑ Ð½Ð° ÑказаннÑÑ Ð´Ð°ÑÑ
| + | |
| − | qFind.SQL.Text =_
| + | |
| − | "SELECT * " &_
| + | |
| − | "FROM gd_currrate r JOIN gd_curr c ON r.fromcurr = c.id " &_
| + | |
| − | "WHERE c.code = :FC and r.tocurr = :TC AND r.fordate = :FD"
| + | |
| − | qFind.ParamByName("TC").AsInteger = BaseCurrID
| + | |
| − |
| + | |
| − | Dim strResult
| + | |
| − | Dim WinHttpReq
| + | |
| − | Dim strURL
| + | |
| − | | + | |
| − | ' еÑли обÑÐµÐºÑ Ð½Ðµ ÑдаеÑÑÑ ÑоздаÑÑ (напÑимеÑ, неподÑ
одÑÑаÑ
| + | |
| − | ' веÑÑÐ¸Ñ Windows), Ñо пÑоÑÑо завеÑÑаем вÑполнение
| + | |
| − | On Error Resume Next
| + | |
| − | Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
| + | |
| − | if Err.Number <> 0 then _
| + | |
| − | Exit Sub
| + | |
| − | On Error GoTo 0
| + | |
| − | | + | |
| − | ' еÑли иÑполÑзÑеÑÑÑ Ð¿ÑокÑи Ð´Ð»Ñ Ð²ÑÑ
ода в инÑеÑнеÑ
| + | |
| − | ' оÑкоменÑиÑÑйÑе ÑледÑÑÑÑÑ ÑÑÑÐ¾ÐºÑ Ð¸ ÑкажиÑе адÑÐµÑ Ð¿ÑокÑи
| + | |
| − | ' поÑледний паÑамеÑÑ, ÑказÑÐ²Ð°ÐµÑ Ð°Ð´ÑеÑа, к коÑоÑÑм подклÑÑение
| + | |
| − | ' бÑÐ´ÐµÑ Ð¿ÑоиÑÑ
одиÑÑ Ð¼Ð¸Ð½ÑÑ Ð¿ÑокÑи
| + | |
| − | ' WinHttpReq.SetProxy 2, "proxy_server:80", "*.domain.com"
| + | |
| − | | + | |
| − | Dim D, K, J, E, SS, Mo, Da, Arr, A
| + | |
| − | For D = FromDate to ToDate Step 1
| + | |
| − | qFind.Close
| + | |
| − | qFind.ParamByName("FD").AsDateTime = D
| + | |
| − | | + | |
| − | q.ParamByName("FD").AsDateTime = D
| + | |
| − |
| + | |
| − | if Month(D) < 10 then
| + | |
| − | Mo = "0" & Month(D)
| + | |
| − | else
| + | |
| − | Mo = Month(D)
| + | |
| − | end if
| + | |
| − | | + | |
| − | if Day(D) < 10 then
| + | |
| − | Da = "0" & Day(D)
| + | |
| − | else
| + | |
| − | Da = Day(D)
| + | |
| − | end if
| + | |
| − | | + | |
| − | strURL = "http://www.nbrb.by/statistics/rates/RatesDaily.asp?fromDate=" &_
| + | |
| − | Year(D) & "-" & Mo & "-" & Da
| + | |
| − |
| + | |
| − | 'strUrl = "http://localhost/nbrb/ratesdaily.asp.htm"
| + | |
| − | | + | |
| − | ' в ÑлÑÑае еÑли ÑÐ°Ð¹Ñ Ð½Ðµ доÑÑÑпен -- пÑоÑÑо
| + | |
| − | ' завеÑÑи пÑоÑедÑÑÑ
| + | |
| − | On Error Resume Next
| + | |
| − |
| + | |
| − | WinHttpReq.Open "GET", strURL, false
| + | |
| − | WinHttpReq.Send
| + | |
| − | strResult = WinHttpReq.ResponseText
| + | |
| − |
| + | |
| − | if Err.Number <> 0 then _
| + | |
| − | Exit Sub
| + | |
| − |
| + | |
| − | On Error GoTo 0
| + | |
| − | | + | |
| − | For Each I in CurrCode
| + | |
| − | ' Ð´Ð»Ñ ÐºÐ°Ð¶Ð´Ð¾Ð¹ валÑÑÑ Ð¿ÑовеÑим: Ð½ÐµÑ Ð»Ð¸ в базе кÑÑÑа на
| + | |
| − | ' ÑказаннÑÑ Ð´Ð°ÑÑ. еÑли еÑÑÑ, Ñо пÑопÑÑкаем ÑÑÑ Ð²Ð°Ð»ÑÑÑ
| + | |
| − | qFind.ParamByName("FC").AsString = CurrCode.Item(I)
| + | |
| − | qFind.ExecQuery
| + | |
| − |
| + | |
| − | if qFind.EOF then
| + | |
| − | Arr = Split(I, ",")
| + | |
| − |
| + | |
| − | For Each A in Arr
| + | |
| − | K = InStr(strResult, ">" & A & "</td>")
| + | |
| − |
| + | |
| − | if K > 0 then
| + | |
| − | For J = 1 to 4
| + | |
| − | K = InStr(K + 1, strResult, ">")
| + | |
| − | if K = 0 then _
| + | |
| − | Exit For
| + | |
| − | Next
| + | |
| − |
| + | |
| − | if K > 0 then
| + | |
| − | K = K + 1
| + | |
| − | E = InStr(K, strResult, "<")
| + | |
| − | | + | |
| − | if E > 0 then
| + | |
| − | SS = Replace(Mid(strResult, K, E - K), " ", "")
| + | |
| − | SS = Replace(SS, " ", "")
| + | |
| − | SS = Replace(SS, Chr(160), "")
| + | |
| − | | + | |
| − | ' на ÑайÑе иÑполÑзÑеÑÑÑ ÑоÑка в каÑеÑÑве деÑÑÑиÑного
| + | |
| − | ' ÑазделиÑелÑ. Ðаменим ее на ÑазделиÑелÑ, иÑполÑзÑÑÑийÑÑ Ð² наÑей
| + | |
| − | ' ÑиÑÑеме
| + | |
| − | SS = Replace(SS, ".", Application.DecimalSeparatorSys)
| + | |
| − | | + | |
| − | if SS > "" then
| + | |
| − | ' в ÑлÑÑае еÑли ÑÑÑÐ¾ÐºÑ Ð½Ðµ ÑдаеÑÑÑ Ð¿ÐµÑевеÑÑи в ÑиÑло
| + | |
| − | ' или Ð²Ð¾Ð·Ð½Ð¸ÐºÐ½ÐµÑ Ð¾Ñибка пÑи добавлении запиÑи --
| + | |
| − | ' пÑоигноÑиÑÑем иÑ
| + | |
| − | On Error Resume Next
| + | |
| − |
| + | |
| − | q.ParamByName("R").AsCurrency = CCur(SS)
| + | |
| − | q.ParamByName("FC").AsString = CurrCode.Item(I)
| + | |
| − |
| + | |
| − | if Err.Number = 0 then _
| + | |
| − | q.ExecQuery
| + | |
| − |
| + | |
| − | On Error GoTo 0
| + | |
| − | end if
| + | |
| − | end if
| + | |
| − | end if
| + | |
| − | end if
| + | |
| − | Next
| + | |
| − | end if
| + | |
| − | | + | |
| − | qFind.Close
| + | |
| − | Next
| + | |
| − | | + | |
| − | Next
| + | |
| − | | + | |
| − | ' подÑвеÑждаем запиÑÑ Ð² Ð±Ð°Ð·Ñ Ð´Ð°Ð½Ð½ÑÑ
, ÑолÑко еÑли вÑе пÑоÑло ÑÑпеÑно
| + | |
| − | ' и не возникало оÑибок
| + | |
| − | Tr.Commit
| + | |
| − | | + | |
| − | end sub
| + | |
| − | </source>
| + | |
| − | | + | |
| − | [[Category:УÑебнÑй кÑÑÑ]]
| + | |
